prova cosi
codice:
Option Explicit
Option Base 1
Dim Numeri_N(19) As String
Dim Numeri_D(9) As String
Private Function Centinaia(Valore As Long) As String
Dim Centinaio As Long
Dim Lettere1 As String
Dim Lettere2 As String
Centinaio = Int(Valore / 100)
Lettere1 = ""
Lettere2 = ""
If Centinaio > 0 Then
If Centinaio = 1 Then
Lettere1 = "cento"
Else
Lettere1 = Numeri_N(Centinaio) & "cento"
End If
End If
Lettere2 = DecineUnita((Valore - (Centinaio * 100)))
Centinaia = Lettere1 & Lettere2
End Function
Private Function DecineUnita(Valore As Long) As String
Dim Decine As Long
Dim Unita As Long
Dim Lettere1 As String
Dim Lettere2 As String
'
Decine = Int(Valore / 10)
Unita = ((Valore / 10) - Int(Valore / 10)) * 10
Lettere1 = ""
Lettere2 = ""
'
If Valore > 0 Then
If Valore < 20 Then
Lettere1 = Numeri_N(Valore)
Else
Lettere1 = Numeri_D(Decine)
If Unita <> 0 Then
Lettere2 = Numeri_N(Unita)
End If
End If
End If
'
DecineUnita = Lettere1 & Lettere2
'
End Function
Function Inizializza()
Numeri_N(1) = "uno"
Numeri_N(2) = "due"
Numeri_N(3) = "tre"
Numeri_N(4) = "quattro"
Numeri_N(5) = "cinque"
Numeri_N(6) = "sei"
Numeri_N(7) = "sette"
Numeri_N(8) = "otto"
Numeri_N(9) = "nove"
Numeri_N(10) = "dieci"
Numeri_N(11) = "undici"
Numeri_N(12) = "dodici"
Numeri_N(13) = "tredici"
Numeri_N(14) = "quattordici"
Numeri_N(15) = "quindici"
Numeri_N(16) = "sedici"
Numeri_N(17) = "diciassette"
Numeri_N(18) = "diciotto"
Numeri_N(19) = "diciannove"
'
Numeri_D(1) = "dieci"
Numeri_D(2) = "venti"
Numeri_D(3) = "trenta"
Numeri_D(4) = "quaranta"
Numeri_D(5) = "cinquanta"
Numeri_D(6) = "sessanta"
Numeri_D(7) = "settanta"
Numeri_D(8) = "ottanta"
Numeri_D(9) = "novanta"
End Function
Private Function MilioniMigliaia(Valore As Long) As String
Dim Numero1 As Long
Dim Numero2 As Long
Dim Milioni As Long
Dim Migliaia As Long
Dim Lettere1 As String
Dim Lettere2 As String
Dim Lettere3 As String
Numero1 = Valore Mod 1000000
Numero2 = Valore Mod 1000
Milioni = Int(Valore / 1000000)
Migliaia = Int(Numero1 / 1000)
Lettere1 = ""
Lettere2 = ""
Lettere3 = ""
If Valore < 1000000000 Then
If Milioni = 0 Then
Lettere1 = ""
Else
If Milioni = 1 Then
Lettere1 = "unmilione"
Else
Lettere1 = Centinaia(Milioni) & "milioni"
End If
End If
'
If Migliaia = 0 Then
Lettere2 = ""
Else
If Migliaia = 1 Then
Lettere2 = "mille"
Else
Lettere2 = Centinaia(Migliaia) & "mila"
End If
End If
Lettere3 = Centinaia(Numero2)
Else
Lettere1 = "Errore"
End If
MilioniMigliaia = Lettere1 & Lettere2 & Lettere3
End Function
Function NumeroToCarattere(Valore As Currency) As String
Dim Intero As Long
Dim Decimale As Long
Dim Diff As Currency
Dim Punto As Long
Dim Count As Long
Dim Lettere1 As String
Dim Lettere2 As String
Dim Lettere3 As String
Intero = Int(Valore)
Decimale = Int((Valore - Int(Valore)) * 10000)
Diff = Valore - Int(Valore)
Punto = InStr(Trim(Str(Valore)), ".")
Lettere1 = ""
Lettere2 = ""
Lettere3 = ""
If Decimale <> 0 Then
Count = Len(Trim(Str(Decimale)))
'
Do While Count <= Len(Trim(Str(Decimale))) And Count <> 0
If Mid(Trim(Str(Decimale)), Count, 1) = "0" Then
Count = Count - 1
Else
Exit Do
End If
Loop
'
Decimale = Mid(Trim(Str(Decimale)), 1, Count)
Count = Punto + 1
'
Do While Count <= Len(Trim(Str(Valore)))
If Mid(Trim(Str(Valore)), Count, 1) = "0" Then
Lettere2 = Lettere2 & "zero"
Count = Count + 1
Else
Exit Do
End If
Loop
End If
'
Lettere1 = MilioniMigliaia(Intero)
'
If Diff = 0 Then
NumeroToCarattere = Lettere1
Else
Lettere3 = MilioniMigliaia(Decimale)
'
If Intero = 0 Then
NumeroToCarattere = "zero virgola " & Lettere2 & Lettere3
Else
If Decimale = 0 Then
NumeroToCarattere = Lettere1
Else
NumeroToCarattere = Lettere1 & " virgola " & Lettere2 & Lettere3
End If
End If
End If
End Function
Private Sub Command1_Click()
Label1.Caption = Text1.Text
Label2.Caption = NumeroToCarattere(Text1.Text)
Text1.Text = ""
End Sub
Private Sub Form_Load()
Call Inizializza
End Sub