conversione numeri in lettere

[DodiPartecipante Dodi Karma: 2 pts]

 rinnovo i saluti a tutti

Esiste un modo per convertire un numero in lettere?

Mi spiego meglio, se nella cella A1 ho un numero, esempio, € 257850,95

e possibile con una macro convertire il numero in lettere?

Il testo deve comparire nella cella D10? Il risultato dovrebbe essere duecentocinquantasettemilaottocentocinquanta/95 euro.

O simile?

Ringrazio anticipatamente

[patelModeratore patel Karma: 51 pts]

Se fai una ricerca con google troverai molte soluzioni. Prima di rivolgersi ad un forum occorre sempre farlo.

[Dodi Dodi]

Ciao Patel,

Grz x il consiglio, mi son subito rivolto al forum xche ho avuto modo più volche che in    qsto forum ci sono  persone molto preparate   e grazie a voi  tutti che mi avete più volte dato una mano, mi fido delle vostre soluzioni,

ma se puoi darmi una dritta ti ringrazio, o cerco in Google.

[Mister_x Mister_x]

ciao

la funzione per questo lavoro , va adattata per il tuo fabbisogno

PS conoscenza di VBA  va inserita in un modulo standard  Autore Emanuele Mattei

''Conversione di Numero in Testo
Option Base 1
Option Explicit

'Array contenente le lettere dei numeri
Dim Strconv(0 To 45) As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Name Function: Public Function convertiNum(strNumero)
'Author: Emanuele Mattei
'Date Crated: 12/09/2004
'Last Modified:
'Description: Converte i numeri in lettere
Public Function ConvertiNum(Strnumero As String)
'variabile per l'importo
Dim CrrEuro As Currency
'centesimi
Dim IntCents As Integer
'variabile di tipo stringa per i centesimi
Dim StrCentesimi As String
'lettere dell'importo
Dim StrLettere As String
'centesimi

StrCentesimi = "00"
'Aggiornamento dello schermo attivato
Application.ScreenUpdating = True

'Imposto i valori dell'array
Strconv(0) = "zero"
Strconv(1) = "uno"
Strconv(2) = "due"
Strconv(3) = "tre"
Strconv(4) = "quattro"
Strconv(5) = "cinque"
Strconv(6) = "sei"
Strconv(7) = "sette"
Strconv(8) = "otto"
Strconv(9) = "nove"
Strconv(10) = "dieci"
Strconv(11) = "undici"
Strconv(12) = "dodici"
Strconv(13) = "tredici"
Strconv(14) = "quattordici"
Strconv(15) = "quindici"
Strconv(16) = "sedici"
Strconv(17) = "diciasette"
Strconv(18) = "diciotto"
Strconv(19) = "diciannove"
Strconv(20) = "venti"
Strconv(21) = "ventuno"
Strconv(22) = "trenta"
Strconv(23) = "trentuno"
Strconv(24) = "quaranta"
Strconv(25) = "quarantuno"
Strconv(26) = "cinquanta"
Strconv(27) = "cinquantuno"
Strconv(28) = "sessanta"
Strconv(29) = "sessantuno"
Strconv(30) = "settanta"
Strconv(31) = "settantuno"
Strconv(32) = "ottanta"
Strconv(33) = "ottantuno"
Strconv(34) = "novanta"
Strconv(35) = "novantuno"
Strconv(36) = "cento"
Strconv(37) = "mille"
Strconv(38) = "mila"
Strconv(39) = "milione"
Strconv(40) = "milioni"
Strconv(41) = "miliardo"
Strconv(42) = "miliardi"
Strconv(43) = "centomila"

'Verifico che ilvalore che sto convertendo sia numerico
If Val(Strnumero) = 0 And IsNumeric(Strnumero) = False Then
MsgBox "La Cella selezionata non è un numero", vbInformation + vbOKOnly, "Shareoffice.it"
ConvertiNum = "#Nome"
Exit Function
ElseIf Val(Strnumero) > 999999999999# Then
MsgBox "La Cella selezionata ha un valore maggiore di 999999999999 ", vbInformation + vbOKOnly, "Shareoffice.it"
ConvertiNum = "#Nome"
Exit Function

End If

'converto il numero in currency
CrrEuro = CCur(Strnumero)

' Formattazione dei centesimi
StrCentesimi = Right(Format(Strnumero, "##,##0.00"), 2)

'testo per centesimi

If CInt(StrCentesimi) < 21 And CInt(StrCentesimi) > 0 Then
StrCentesimi = num_venti(CLng(StrCentesimi))
ElseIf CInt(StrCentesimi) >= 21 And CInt(StrCentesimi) < 100 Then StrCentesimi = num_cento(CLng(StrCentesimi)) End If CrrEuro = Fix(CrrEuro) If CrrEuro < 21 Then StrLettere = num_venti(CLng(CrrEuro)) ElseIf CrrEuro >= 21 And CrrEuro < 100 Then StrLettere = num_cento(CLng(CrrEuro)) ElseIf CrrEuro >= 100 And CrrEuro < 1000 Then StrLettere = num_mille(CLng(CrrEuro)) ElseIf CrrEuro >= 1000 And CrrEuro < 100000 Then StrLettere = num_centomila(CLng(CrrEuro), 0) ElseIf CrrEuro >= 100000 And CrrEuro < 1000000 Then StrLettere = num_milione(CLng(CrrEuro)) ElseIf CrrEuro >= 1000000 And CrrEuro < 1000000000 Then StrLettere = num_miliardo(CLng(CrrEuro)) 'conversione per i miliardi ElseIf CrrEuro >= 1000000000 And CrrEuro < 1000000000000# Then StrLettere = num_miliardi(Format(CrrEuro, "##,##0")) End If 'restituisco il valore ConvertiNum = "(" & StrLettere & "/" & StrCentesimi & ")"

End Function

Private Function num_venti(LngNum As Long)
num_venti = Strconv(LngNum)
End Function

Private Function num_cento(LngNum As Long)
Dim inNum1 As Integer
Dim IntNum2 As Integer
Dim StrLettera As String
On Error GoTo errore
If LngNum > 0 And LngNum < 21 Then num_cento = num_venti(LngNum) Else inNum1 = Int(LngNum / 10) If LngNum = 21 + (10 * (inNum1 - 2)) Then num_cento = Strconv((21 + (2 * (inNum1 - 2)))) Else StrLettera = Strconv((20 + (2 * (inNum1 - 1) - 2))) IntNum2 = LngNum - (inNum1 * 10) If IntNum2 = 0 Then num_cento = StrLettera Else num_cento = StrLettera & Strconv(IntNum2) End If End If End If Exit Function errore: MsgBox Err.Description, vbInformation, "num_cento" End Function 'funzione mille Private Function num_mille(LngNum As Long) Dim IntNum1 As Integer Dim IntNum2 As Integer Dim StrLettera As String On Error GoTo errore If LngNum = 100 Then num_mille = Strconv(36) ElseIf LngNum > 100 And LngNum < 200 Then IntNum1 = LngNum - 100 StrLettera = Strconv(36) num_mille = StrLettera & num_cento(CLng(IntNum1)) ElseIf LngNum >= 200 And LngNum < 1000 Then IntNum1 = Int(LngNum / 100) StrLettera = Strconv(IntNum1) & Strconv(36) IntNum2 = LngNum - (IntNum1 * 100) If LngNum <> 100 * IntNum1 Then
num_mille = StrLettera & num_cento(CLng(IntNum2))
Else
num_mille = StrLettera
End If
End If
Exit Function
errore:
MsgBox Err.Description, vbInformation, "Num_mille"
End Function
'funzione che converto il testo dei centomila
Private Function num_centomila(LngNum As Long, flag As Boolean)
Dim IntNum1 As Integer
Dim lngNum2 As Long
Dim StrLettera As String
StrLettera = "mila"
On Error GoTo errore
IntNum1 = Int(LngNum / 1000)
If IntNum1 = 1 And LngNum = 1000 Then
If flag = 0 Then
StrLettera = Strconv(37)
Else
StrLettera = Strconv(1)
StrLettera = StrLettera & Strconv(38)

End If
ElseIf IntNum1 = 1 And LngNum <> 1000 Then
If flag = 0 Then
StrLettera = Strconv(37)
Else
StrLettera = Strconv(1)
StrLettera = StrLettera & Strconv(38)
End If
lngNum2 = LngNum - 1000
If lngNum2 < 100 Then StrLettera = StrLettera & num_cento(lngNum2) Else StrLettera = StrLettera & num_mille(lngNum2) End If ElseIf IntNum1 > 1 And IntNum1 < = 21 Then StrLettera = Strconv(IntNum1) StrLettera = StrLettera & Strconv(38) lngNum2 = LngNum - (IntNum1 * 1000) If lngNum2 >= 1 And lngNum2 < 100 Then StrLettera = StrLettera & num_cento(lngNum2) ElseIf lngNum2 >= 100 Then
StrLettera = StrLettera & num_mille(lngNum2)
End If
ElseIf IntNum1 > 21 And IntNum1 < 100 Then StrLettera = num_cento(CLng(IntNum1)) StrLettera = StrLettera & Strconv(38) lngNum2 = LngNum - (CLng(IntNum1) * 1000) If lngNum2 >= 1 And lngNum2 < 100 Then StrLettera = StrLettera & num_cento(lngNum2) ElseIf lngNum2 >= 100 Then
StrLettera = StrLettera & num_mille(lngNum2)
End If
End If
num_centomila = StrLettera
Exit Function
errore:
MsgBox Err.Description, vbInformation, "Num_centomila"
End Function

'funzione concerti in milioni
Private Function num_milione(LngNum As Long)
On Error GoTo errore
Dim IntNum1 As Integer
Dim lngNum2 As Long
Dim StrLettera As String

IntNum1 = Int(LngNum / 100000)
If IntNum1 = 1 And LngNum = 100000 Then
StrLettera = Strconv(43)
ElseIf IntNum1 = 1 And LngNum <> 100000 Then
StrLettera = Strconv(36)
lngNum2 = LngNum - 100000
If lngNum2 >= 1 And lngNum2 < 100 Then StrLettera = StrLettera & Strconv(38) StrLettera = StrLettera & num_cento(CLng(lngNum2)) ElseIf lngNum2 >= 100 And lngNum2 < 1000 Then StrLettera = StrLettera & Strconv(38) StrLettera = StrLettera & num_mille(CLng(lngNum2)) Else StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1) End If ElseIf IntNum1 > 1 Then
StrLettera = Strconv(IntNum1)
StrLettera = StrLettera & Strconv(36)
lngNum2 = LngNum - (100000 * IntNum1)
If lngNum2 > 0 And lngNum2 < 22 Then StrLettera = StrLettera & Strconv(38) StrLettera = StrLettera & num_venti(CLng(lngNum2)) ElseIf lngNum2 >= 22 And lngNum2 < 1000 Then StrLettera = StrLettera & Strconv(38) StrLettera = StrLettera & num_mille(CLng(lngNum2)) Else StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1) End If End If num_milione = StrLettera Exit Function errore: MsgBox Err.Description, vbInformation, "Num_milione" End Function 'Funzione che converti gli importi sotto al 999.999.999 Private Function num_miliardo(LngNum As Long) Dim IntNum1 As Integer Dim lngNum2 As Long Dim StrLettera As String On Error GoTo errore IntNum1 = Int(LngNum / 1000000) If IntNum1 = 1 And LngNum = 1000000 Then StrLettera = "un" & Strconv(39) ElseIf IntNum1 = 1 And LngNum <> 1000000 Then
StrLettera = "un" & Strconv(39)
lngNum2 = LngNum - 1000000
If lngNum2 >= 1 And lngNum2 < 100 Then StrLettera = StrLettera & num_cento(CLng(lngNum2)) ElseIf lngNum2 >= 100 And lngNum2 < 1000 Then StrLettera = StrLettera & num_mille(CLng(lngNum2)) 'nuova modifica ElseIf lngNum2 >= 1000 And lngNum2 < 100000 Then StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1) Else StrLettera = StrLettera & num_milione(CLng(lngNum2)) End If ElseIf IntNum1 > 1 Then
If IntNum1 > 21 And IntNum1 < 100 Then StrLettera = num_cento(CLng(IntNum1)) ElseIf IntNum1 >= 100 And IntNum1 < 1000 Then StrLettera = num_mille(CLng(IntNum1)) Else StrLettera = Strconv(CLng(IntNum1)) End If StrLettera = StrLettera & Strconv(40) lngNum2 = LngNum - (1000000 * IntNum1) If lngNum2 >= 1 And lngNum2 < 100 Then StrLettera = StrLettera & num_cento(CLng(lngNum2)) ElseIf lngNum2 >= 100 And lngNum2 < 1000 Then StrLettera = StrLettera & num_mille(CLng(lngNum2)) ElseIf lngNum2 >= 1000 And lngNum2 < 100000 Then StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1) Else StrLettera = StrLettera & num_milione(CLng(lngNum2)) End If End If num_miliardo = StrLettera Exit Function errore: MsgBox Err.Description, vbInformation, "Num_miliardo" End Function

'Converte gli importi sotto i 999.999.999.999
Private Function num_miliardi(LngNum As Currency)
Dim IntNum1 As Integer
Dim lngNum2 As Long
'variabile per il calcolo della differnza
Dim CrrTemporaneo As Currency

Dim StrLettera As String
On Error GoTo errore
IntNum1 = Int(LngNum / 1000000000)
If IntNum1 = 1 And LngNum = 1000000000 Then
StrLettera = "un" & Strconv(41)
ElseIf IntNum1 = 1 And LngNum <> 1000000000 Then
StrLettera = "un" & Strconv(41)
lngNum2 = LngNum - 1000000000
If lngNum2 >= 1 And lngNum2 < 100 Then StrLettera = StrLettera & num_cento(CLng(lngNum2)) ElseIf lngNum2 >= 100 And lngNum2 < 1000 Then StrLettera = StrLettera & num_mille(CLng(lngNum2)) ElseIf lngNum2 >= 100000 And lngNum2 < 1000000000 Then StrLettera = StrLettera & num_miliardo(lngNum2) Else StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1) End If ElseIf IntNum1 > 1 Then
If IntNum1 > 21 And IntNum1 < 100 Then StrLettera = num_cento(CLng(IntNum1)) ElseIf IntNum1 >= 100 And IntNum1 < 1000 Then StrLettera = num_mille(CLng(IntNum1)) Else StrLettera = Strconv(CLng(IntNum1)) End If StrLettera = StrLettera & Strconv(42) 'lo valorizzo con il valore di un miliardo CrrTemporaneo = 1000000000 CrrTemporaneo = CrrTemporaneo * IntNum1 lngNum2 = LngNum - CrrTemporaneo If lngNum2 >= 1 And lngNum2 < 100 Then StrLettera = StrLettera & num_cento(CLng(lngNum2)) ElseIf lngNum2 >= 100 And lngNum2 < 1000 Then StrLettera = StrLettera & num_mille(CLng(lngNum2)) ElseIf lngNum2 >= 1000 And lngNum2 < 100000 Then StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1) ElseIf lngNum2 >= 100000 And lngNum2 < 1000000000 Then StrLettera = StrLettera & num_miliardo(lngNum2) Else StrLettera = StrLettera & num_milione(CLng(lngNum2)) End If End If num_miliardi = StrLettera Exit Function errore: MsgBox Err.Description, vbInformation, "Num_miliardi" End Function

 ciao

[Dodi Dodi]

Ti ringrazio x la risposta,  mi sembra un codice infinito e complesso, pensavo che ci fosse qualcosa di più semplice e più adatto alle mie esigenze avevo trovato qualcosa di simile su Google, ma quando converte i numeri in lettere fa riferimento alle lire e non alla valuta euro, e mi spiego meglio se scrivo 23400,00 il codice lo trasforma in ventitremilioniquattrocento e non ventitremilaquatocento. quindi usa come sistema di trasformazione in lire.

qualcuno puo esser cosi gentile a darmi una soluzione che fa al mio caso.

Grazie

[OscarPartecipante Oscar Karma: 44 pts]

Questa è in Euro

Option Explicit
Private Function Unita(ByVal k As Integer) As String
Dim Lettere() As String
Lettere = Split(",uno,due,tre,quattro,cinque,sei,sette,otto,nove,dieci,undici,dodici,tredici,quattordici,quindici,sedici,diciassette,diciotto,diciannove", ",")
If (k < 0) Or (k > UBound(Lettere)) Then
Unita = ""
Else
Unita = Lettere(k)
End If
End Function

Private Function Decine(ByVal k As Integer) As String
Dim Lettere() As String
Lettere = Split(",dieci,venti,trenta,quaranta,cinquanta,sessanta,settanta,ottanta,novanta", ",")
If (k < 0) Or (k > UBound(Lettere)) Then
Decine = ""
Else
Decine = Lettere(k)
End If
End Function

Private Function Migliaia(ByVal k As Integer) As String
Dim Lettere() As String
Lettere = Split(",mille,unmilione,unmiliardo,millemiliardi,mila,milioni,miliardi,milamiliardi,milamiliardi,migliaiadimiliardi", ",")
If (k < 0) Or (k > UBound(Lettere)) Then
Migliaia = ""
Else
Migliaia = Lettere(k)
End If
End Function

Private Function CalcolaLettere(ByVal Importo As Currency) As String
Dim result As String
result = ""
Dim intero As String
intero = Format(Importo, "0.00")
Dim resto As String
resto = "/" + Right(intero, 2)
intero = Left(intero, Len(intero) - 3)
If Left(intero, 1) = "-" Then
intero = Mid(intero, 2)
End If
If Importo = 0 Then
CalcolaLettere = "zero/00"
Exit Function
End If
Dim mille As Integer
mille = -1
Dim k As Integer
k = Len(intero) Mod 3
If Not (k = 0) Then
intero = String(3 - k, "0") + intero
End If
While Not (intero = "")
mille = mille + 1
Dim parziale As String
parziale = ""
Dim tripla As String
tripla = Right(intero, 3)
Dim s As String
s = ""
intero = Left(intero, Len(intero) - 3)
Dim tv As Integer
tv = CInt(tripla)
Dim td As Integer
td = tv Mod 100
Dim tc As Integer
tc = (tv - td) / 100
If Not (tc = 0) Then
parziale = "cento"
If tc > 1 Then
parziale = Unita(tc) + parziale
End If
End If
If td < 20 Then
parziale = parziale + Unita(td)
Else
Dim x As Integer
x = td Mod 10
Dim y As Integer
y = (td - x) / 10
parziale = parziale + Decine(y)
s = Unita(x)
If (InStr(1, "uo", Left(s, 1)) <> 0) And (s <> "") And (Not (y = 0)) Then
parziale = Left(parziale, Len(parziale) - 1)
End If
parziale = parziale + s
End If
s = Migliaia(mille)
If (mille > 0) And (Not (parziale = "")) Then
k = mille
If Not (parziale = "uno") Then
k = k + 4
s = Migliaia(k)
If Right(parziale, 3) = "uno" Then
parziale = Left(parziale, Len(parziale) - 1)
End If
Else
parziale = ""
End If
parziale = parziale + s
End If
result = parziale + result
Wend
If Importo < 0 Then
result = "meno" + result
End If
CalcolaLettere = result + resto
End Function
Public Function Cifre2Lettere(ByVal Importo As Currency) As String
Cifre2Lettere = CalcolaLettere(Importo)
End Function

[OscarPartecipante Oscar Karma: 44 pts]

Ti allego il File di esempio

[DodiPartecipante Dodi Karma: 2 pts]

Oscar

grazie per la soluzione,

saluto tutti su qsto forum

sempre molto gentili e disponibili,

[Autore]

Articoli