Originariamente inviato da dieghito101
Ciao a tutti,
sto facendo un programma in VB6 e SQL2000 e avrei il seguente problema:
qualcuno di voi ha una vaga idea di come potrei fare per leggere un numero ( scritto in cifre ) e scriverlo in lettere? un po' come si fa sugli assegni...
accettoo soluzioni sia in VB che in T-SQL!!
Grazie mille a chiunque abbia un suggerimento!
codice:
'*********************************
Dim sUnita(19) As String
Dim sDecina(9) As String
Private Sub Form_Load()
Dim N As String
N = "1234567890123,15"
MsgBox NumeroInLettere(N)
Unload Me
End Sub
'******************************************************************************
' NumeroToLettere
'
' Converte il numero intero in lettere
'
' Input : ImportoN -->Importo Numerico
'
' Ouput : NumeroToLettere -->Il numero in lettere
'******************************************************************************
Function NumeroInLettere(Numero As String) As String
'************************
'Gestisce la virgola
'************************
Dim PosVirg As Integer
Dim Lettere As String
Numero$ = ChangeStr(Numero$, ".", "")
PosVirg% = InStr(Numero$, ",")
If PosVirg% Then
Lettere$ = NumInLet(Mid(Numero$, 1, Len(Numero) + PosVirg% - 1))
Lettere$ = Lettere$ & "\" & Format(Mid(Numero$, PosVirg% + 1, Len(Numero$)), "00")
Else
Lettere$ = NumInLet(CDbl(Numero$))
End If
NumeroInLettere = Lettere$
End Function
Private Function NumInLet(N As Double) As String
'************************************************
'inizializzo i due arry di numeri
'************************************************
SetNumeri
Dim ValT As Double 'Valore Temporaneo per la conversione
Dim iCent As Integer 'Valore su cui calcolare le centinaia
Dim L As String 'Importo in Lettere
NumInLet = "zero"
If N = 0 Then Exit Function
ValT = N
L = ""
'miliardi
iCent = Int(ValT / 1000000000#)
If iCent Then
If iCent = 1 Then
L = "UnMiliardo"
Else
L = LCent(iCent) + "Miliardi"
End If
ValT = ValT - CDbl(iCent) * 1000000000#
End If
'milioni
iCent = Int(ValT / 1000000#)
If iCent Then
If iCent = 1 Then
L = L + "UnMilione"
Else
L = L + LCent(iCent) + "Milioni"
End If
ValT = ValT - CDbl(iCent) * 1000000#
End If
'miliaia
iCent = Int(ValT / 1000)
If iCent Then
If iCent = 1 Then
L = L + "Mille"
Else
L = L + LCent(iCent) + "mila"
End If
ValT = ValT - CDbl(iCent) * 1000
End If
'centinaia
If ValT Then
L = L + LCent(CInt(ValT))
End If
NumInLet = L
End Function
Function LCent(N As Integer) As String
' Ritorna xx% (1/999) convertito in lettere
Dim Numero As String
Dim Lettere As String
Dim Centinaia As Integer
Dim Decine As Integer
Dim x As Integer
Dim Unita As Integer
Dim sDec As String
Numero$ = Format(N, "000")
Lettere$ = ""
Centinaia% = Val(Left$(Numero$, 1))
If Centinaia% Then
If Centinaia% > 1 Then
Lettere = sUnita(Centinaia%)
End If
Lettere = Lettere + "Cento"
End If
Decine% = (N Mod 100)
If Decine% Then
Select Case Decine%
Case Is >= 20 'Decine
sDec = sDecina(Val(Mid$(Numero$, 2, 1)))
x% = Len(sDec)
Unita% = Val(Right$(Numero$, 1)) 'Unita
If Unita% = 1 Or Unita% = 8 Then x% = x% - 1
Lettere$ = Lettere$ & Left(sDec, x%) & sUnita(Unita%) 'Tolgo l'ultima lettera della decina per i
Case Else
Lettere$ = Lettere$ + sUnita(Decine)
End Select
End If
LCent$ = Lettere$
End Function
Sub SetNumeri()
'************************************************
' Stringhe per traslitterazione numeri
'************************************************
sUnita(1) = "Uno"
sUnita(2) = "Due"
sUnita(3) = "Tre"
sUnita(4) = "Quattro"
sUnita(5) = "Cinque"
sUnita(6) = "Sei"
sUnita(7) = "Sette"
sUnita(8) = "Otto"
sUnita(9) = "Nove"
sUnita(10) = "Dieci"
sUnita(11) = "Undici"
sUnita(12) = "Dodici"
sUnita(13) = "Tredici"
sUnita(14) = "Quattordici"
sUnita(15) = "Quindici"
sUnita(16) = "Sedici"
sUnita(17) = "Diciassette"
sUnita(18) = "Diciotto"
sUnita(19) = "Diciannove"
sDecina(1) = "Dieci"
sDecina(2) = "Venti"
sDecina(3) = "Trenta"
sDecina(4) = "Quaranta"
sDecina(5) = "Cinquanta"
sDecina(6) = "Sessanta"
sDecina(7) = "Settanta"
sDecina(8) = "Ottanta"
sDecina(9) = "Novanta"
End Sub
'*********************************************************************
' ChangeStr - da usare con versioni minori del Vb6
'
'Input = Stringa -->Da convertire
' Lettera da sostituire -->Da convertire
' Nuova lettera da rimpiazzare -->Da convertire
'
'Ouput = Stringa rimpiazzata
'
'*********************************************************************
Function ChangeStr(ByRef sBuffer As String, ByRef OldChar As String, _
ByRef NewChar As String) As String
Dim TmpBuf As String
Dim p As Integer
On Error GoTo ErrChangeStr
ChangeStr$ = "" 'Default Error
TmpBuf$ = sBuffer$
p% = InStr(TmpBuf$, OldChar$)
Do While p > 0
TmpBuf$ = Left$(TmpBuf$, p% - 1) + NewChar$ + Mid$(TmpBuf$, p% + Len(OldChar$))
p% = InStr(p% + Len(NewChar$), TmpBuf$, OldChar$)
Loop
ChangeStr$ = TmpBuf$
Exit Function
ErrChangeStr:
ChangeStr$ = ""
End Function
:tongue:
David
Permessi di invio
Rispondi quotando