PDA

Visualizza la versione completa : codice access per convertire i numeri da cifre in lettere


reddy
30-10-2001, 10:45
ho modificato un codice di microsoft in modo che permetta anche la traduzione per l'euro (decimali inclusi). assicuro che funziona. spero vi interessi ... grazie per i contributi e ciao a tutti

Option Compare Database 'Utilizza il tipo di ordinamento del database per i confronti fra stringhe
Option Explicit
Option Base 1
Dim Tabella_Nomi(19) As String
Dim Tabella_Decine(9) As String
Dim Tabella_Decin(9) As String
Dim Tabella_Cent(2) As String

Private Function Centinaia(Numero As Double) As String
Dim NumCentinaia As Integer, StrCentinaia As String
NumCentinaia = Int(Numero / 100)
If NumCentinaia > 0 Then
If NumCentinaia = 1 Then
StrCentinaia = "cento"
Else
StrCentinaia = Tabella_Nomi(NumCentinaia) & "cento"
End If
End If
Centinaia = StrCentinaia & Decine_e_Unita(Numero - (NumCentinaia * 100))
End Function
Private Function Decine_e_Unita(Numero As Double) As String
Dim Decine As String, Unita As Integer, Decin As String

If Numero = 0 Then
Decine_e_Unita = ""
Else
If Numero < 20 Then
Decine_e_Unita = Tabella_Nomi(Numero)
Else
Decine = Tabella_Decine(Int(Numero / 10))
Decin = Tabella_Decin(Int(Numero / 10))
Unita = Numero Mod 10
If Unita = 0 Then
Decine_e_Unita = Decine
ElseIf Unita = 1 Then
Decine_e_Unita = Decin & Tabella_Nomi(Unita)
ElseIf Unita = 8 Then
Decine_e_Unita = Decin & Tabella_Nomi(Unita)
Else
Decine_e_Unita = Decine & Tabella_Nomi(Unita)
End If
End If
End If
End Function
Function Inizializza_variabili()
' Inizializza tabella al caricamento del modulo
Tabella_Nomi(1) = "uno"
Tabella_Nomi(2) = "due"
Tabella_Nomi(3) = "tre"
Tabella_Nomi(4) = "quattro"
Tabella_Nomi(5) = "cinque"
Tabella_Nomi(6) = "sei"
Tabella_Nomi(7) = "sette"
Tabella_Nomi(8) = "otto"
Tabella_Nomi(9) = "nove"
Tabella_Nomi(10) = "dieci"
Tabella_Nomi(11) = "undici"
Tabella_Nomi(12) = "dodici"
Tabella_Nomi(13) = "tredici"
Tabella_Nomi(14) = "quattordici"
Tabella_Nomi(15) = "quindici"
Tabella_Nomi(16) = "sedici"
Tabella_Nomi(17) = "diciassette"
Tabella_Nomi(18) = "diciotto"
Tabella_Nomi(19) = "diciannove"
Tabella_Decine(1) = "dieci"
Tabella_Decine(2) = "venti"
Tabella_Decine(3) = "trenta"
Tabella_Decine(4) = "quaranta"
Tabella_Decine(5) = "cinquanta"
Tabella_Decine(6) = "sessanta"
Tabella_Decine(7) = "settanta"
Tabella_Decine(8) = "ottanta"
Tabella_Decine(9) = "novanta"
Tabella_Decin(2) = "vent"
Tabella_Decin(3) = "trent"
Tabella_Decin(4) = "quarant"
Tabella_Decin(5) = "cinquant"
Tabella_Decin(6) = "sessant"
Tabella_Decin(7) = "settant"
Tabella_Decin(8) = "ottant"
Tabella_Decin(9) = "novant"
Tabella_Cent(1) = "uncentesimo"
Tabella_Cent(2) = "centesimi"
End Function
Private Function Milioni_e_Migliaia(Numero As Double) As String
Dim Assoluto As Double, NumMilioni As Double, Milioni As String, Var1 As Double, NumMigliaia As Double, Migliaia As String
If Numero > 999999999 Then
Milioni_e_Migliaia = "Numero troppo grande !"
Exit Function
End If
Assoluto = Int(Numero)
NumMilioni = Int(Assoluto / 1000000)
If NumMilioni = 0 Then
Milioni = ""
ElseIf NumMilioni = 1 Then
Milioni = "unmilione"
Else
Milioni = Centinaia(NumMilioni) & "milioni"
End If
Var1 = Assoluto Mod 1000000
NumMigliaia = Int(Var1 / 1000)
If NumMigliaia = 1 Then
Migliaia = "mille"
Else
If NumMigliaia <> 0 Then Migliaia = Centinaia(NumMigliaia) & "mila"
End If
Milioni_e_Migliaia = Milioni & Migliaia & Centinaia(Var1 Mod 1000)
End Function
Function NumToCar(Numero As Double) As String
Dim Virgola As Integer
Dim StrIntero As String
Dim Decimale As String
Dim dec As Integer

dec = (Numero) - Int(Numero)
StrIntero = Milioni_e_Migliaia(Int(Numero))

Virgola = InStr(1, Str$(Numero), ".", 0)
If Virgola = 0 Then
NumToCar = StrIntero
Else
Decimale = Milioni_e_Migliaia(Val(Mid$(Str$(Numero), Virgola + 1, 2)))
If Int(Numero) = 0 Then
NumToCar = "zero e " & Decimale & "centesimi"
Else
If (Decimale = "") Then
NumToCar = StrIntero
Else
If (Decimale = "uno") Then
Decimale = "un"
NumToCar = StrIntero & " e " & Decimale & "centesimo"
Else
NumToCar = StrIntero & " e " & Decimale & "centesimi"
End If
End If
End If
End If
End Function

;)