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 |