si fa con la seguente macro
codice:
Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Function Trasforma_Gruppo(s As String) As String
Dim Ris As String
Dim us As String
Dim ds As String
Dim cs As String
u = Mid$(s, 3, 1)
d = Mid$(s, 2, 1)
c = Mid$(s, 1, 1)
cs = ""
ds = ""
us = ""
Select Case u ' unità
Case "1": us = "uno"
Case "2": us = "due"
Case "3": us = "tre"
Case "4": us = "quattro"
Case "5": us = "cinque"
Case "6": us = "sei"
Case "7": us = "sette"
Case "8": us = "otto"
Case "9": us = "nove"
End Select
Select Case d ' decine
Case "1": ds = "dieci"
Case "2": ds = "venti"
Case "3": ds = "trenta"
Case "4": ds = "quaranta"
Case "5": ds = "cinquanta"
Case "6": ds = "sessanta"
Case "7": ds = "settanta"
Case "8": ds = "ottanta"
Case "9": ds = "novanta"
End Select
Select Case c ' centinaia
Case "1": cs = "cento"
Case "2": cs = "duecento"
Case "3": cs = "trecento"
Case "4": cs = "quattrocento"
Case "5": cs = "cinquecento"
Case "6": cs = "seicento"
Case "7": cs = "settecento"
Case "8": cs = "ottocento"
Case "9": cs = "novecento"
End Select
If ds = "dieci" Then
us = ""
Select Case u
Case "1": ds = "undici"
Case "2": ds = "dodici"
Case "3": ds = "tredici"
Case "4": ds = "quattordici"
Case "5": ds = "quindici"
Case "6": ds = "sedici"
Case "7": ds = "diciassette"
Case "8": ds = "diciotto"
Case "9": ds = "diciannove"
End Select
End If
If (ds <> "") And ((us = "uno") Or (us = "otto")) Then ds = Left$(ds, Len(ds) - 1)
' con uno e otto si elimina la vocale finale delle decine
Ris = cs + ds + us
Trasforma_Gruppo = Ris
End Function
Function Trasforma_in_lettere(n As Long) As String
Dim s As String
Dim ns As String
Dim grp1 As String
Dim grp2 As String
Dim grp3 As String
Dim grp4 As String
ns = Str$(n)
ns = Mid$(ns, 2)
s = Left$("000000000000", 12 - Len(ns)) + ns
grp1 = Trasforma_Gruppo(Right$(s, 3))
grp2 = Trasforma_Gruppo(Mid$(s, 7, 1) + Mid$(s, 8, 1) + Mid$(s, 9, 1))
grp3 = Trasforma_Gruppo(Mid$(s, 4, 1) + Mid$(s, 5, 1) + Mid$(s, 6, 1))
grp4 = Trasforma_Gruppo(Left$(s, 3))
If grp2 <> "" Then
If grp2 = "uno" Then grp2 = "mille" Else grp2 = grp2 + "mila"
End If
If grp3 <> "" Then
If grp3 = "uno" Then grp3 = "unmilione" Else grp3 = grp3 + "milioni"
End If
If grp4 <> "" Then
If grp4 = "uno" Then grp4 = "unmiliardo" Else grp4 = grp4 + "miliardi"
End If
Trasforma_in_lettere = grp4 + grp3 + grp2 + grp1
End Function
e inserendo nella cella
=Trasforma_in_lettere(A4)