Aiuto: numeri in lettere

martedì 28 aprile 2009 - 10.17

Elenco Threads

Stanze Forum

Aggiungi ai Preferiti

Cerca nel forum

FRANSIS Profilo | Newbie

1 messaggi | Data Invio: mar 28 apr 2009 - 10:17

Ciao esperti di VB
avrei bisogno di un grosso aiuto, se possibile....
Il Vb per me è davvero "arabo" così ho trovato una formula girovagando su internet che trasforma i numeri decimali in lettere, che vi appiccico di seguito che ho incollato nel codice di un report e poi ho creato una casellina dove ho diguitato la seguente formula:
=Numeroinlettere(Format([importo];"Standard")), però ho scoperto che quando inserisco una cifra con decimali superiori al 51 mi restituisce il valore successivo, es:
10,50= dieci/50
10,51= undici/51
e non ho la più pallida idea di come rIsolverlo????

Risute a darmi una manina GRAZIE!!!!!!!!!

Il codice trovato è:

'*********************************
Dim sUnita(19) &n bsp; As String
Dim sDecina(9) &n bsp; 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 &nbs p; -->Importo Numerico
'
' Ouput : NumeroToLettere &nb sp; -->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 &n bsp; As Double 'Valore Temporaneo per la conversione
Dim iCent & nbsp; 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 &nb sp; &nb sp; As Integer
Dim Decine As Integer
Dim x ; ; As Integer
Dim Unita & nbsp; & nbsp; As Integer
Dim sDec &n bsp; &n bsp; 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 &nbs p; &nbs p; &nbs p; '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 &n bsp; -->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

Torna su

Stanze Forum

Elenco Threads

Partecipa anche tu! Registrati!

Hai bisogno di aiuto ?
Perchè non ti registri subito?

Dopo esserti registrato potrai chiedere
aiuto sul nostro Forum oppure aiutare gli altri

Consulta le Stanze disponibili.

Registrati ora !