NumToLetterIta




Function Lettere(wknumero, Optional Tipo As Variant) As String
'Nota il se Tipo e' 1=maiuscolo, se 2=minuscolo

'se 3=capitalizzato

Dim WkCentinaia, WkMigliaia, WkMilioni, WkMiliardi, WkStringa As String
Dim pass As Byte

wknumero = Str$(Int(wknumero))
wknumero = Space(12 - Len(wknumero)) + wknumero
WkMiliardi = Left$(wknumero, 3)
WkMilioni = Mid$(wknumero, 4, 3)
WkMigliaia = Mid$(wknumero, 7, 3)
WkCentinaia = Mid$(wknumero, 10, 3)
WkStringa = ""
For pass = 1 To 4
Select Case pass
Case Is = 1
If Val(WkMiliardi) = 1 Then
WkStringa = WkStringa + "unmiliardo"
End If
If Val(WkMiliardi) > 1 Then
WkStringa = WkStringa + NumTrd(WkMiliardi) + "miliardi"
End If
Case Is = 2
If Val(WkMilioni) = 1 Then
WkStringa = WkStringa + "unmilione"
End If
If Val(WkMilioni) > 1 Then
WkStringa = WkStringa + NumTrd(WkMilioni) + "milioni"
End If
Case Is = 3
If Val(WkMigliaia) = 1 Then
WkStringa = WkStringa + "mille"
End If
If Val(WkMigliaia) > 1 Then
WkStringa = WkStringa + NumTrd(WkMigliaia) + "mila"
End If
Case Is = 4
If Val(WkCentinaia) > 0 Then
WkStringa = WkStringa + NumTrd(WkCentinaia)
End If
If Val(WkCentinaia) = 0 Then
If WkStringa = "" Then WkStringa = "zero"
End If
End Select
Next

If Tipo = 1 Then Lettere = StrConv(WkStringa, vbUpperCase)
If Tipo = 2 Then Lettere = StrConv(WkStringa, vbLowerCase)
If Tipo = 3 Then Lettere = StrConv(WkStringa, vbProperCase)

End Function

Function cifranum(item) As String
Dim cifra(27) As String
cifra(1) = "uno"
cifra(2) = "due"
cifra(3) = "tre"
cifra(4) = "quattro"
cifra(5) = "cinque"
cifra(6) = "sei"
cifra(7) = "sette"
cifra(8) = "otto"
cifra(9) = "nove"
cifra(10) = "dieci"
cifra(11) = "undici"
cifra(12) = "dodici"
cifra(13) = "tredici"
cifra(14) = "quattordici"
cifra(15) = "quindici"
cifra(16) = "sedici"
cifra(17) = "diciassette"
cifra(18) = "diciotto"
cifra(19) = "diciannove"
cifra(20) = "venti"
cifra(21) = "trenta"
cifra(22) = "quaranta"
cifra(23) = "cinquanta"
cifra(24) = "sessanta"
cifra(25) = "settanta"
cifra(26) = "ottanta"
cifra(27) = "novanta"
cifranum = cifra(item)
End Function

Function GetCifra(item) As String
Dim CurrItem As String
If item <= 20 Then
CurrItem = cifranum(item)
Else
CurrItem = cifranum((item - 30) / 10 + 21)
End If
GetCifra = CurrItem
End Function

Function NumTrd(WkNum)
Dim WkCif1, WkCif2, WkCif3 As Integer
Dim WkCif As String
WkNum = Space(3 - Len(WkNum)) + WkNum
WkCif = ""
WkCif1 = Val(Left(WkNum, 1))
WkCif2 = Val(Mid$(WkNum, 2, 1))
WkCif3 = Val(Mid$(WkNum, 3, 1))
If WkCif1 = 1 Then
WkCif = "cento"
End If
If WkCif1 > 1 Then
WkCif = GetCifra(WkCif1) + "cento"
End If
If WkCif2 > 1 And (WkCif3 = 1 Or WkCif3 = 8) Then
WkCif = WkCif + Left(GetCifra(WkCif2 * 10), Len(GetCifra(WkCif2 * 10)) - 1)
ElseIf WkCif2 > 1 And WkCif3 > 1 Then
WkCif = WkCif + GetCifra(WkCif2 * 10)
ElseIf WkCif2 > 0 Then
WkCif = WkCif + GetCifra(WkCif2 * 10 + WkCif3)
WkCif3 = 0
End If
If WkCif3 > 0 Then
WkCif = WkCif + GetCifra(WkCif3)
End If
NumTrd = WkCif
End Function










( numtoletterita.html )- by Paolo Puglisi - Modifica del 17/12/2023