Demo - Converte Numero da Cifre in Lettere

' (By65Franco) CONVERTE NUMERO DA CIFRE IN LETTERE
' Parametri da passare alla function
' nMyNumero = numero in cifre da convertire in lettere
' strSeparatore = separatore da applicare per stile assegno (esempio... "/")
' blnStile = stile di converione: True = stile assegno - False = tutto in lettere
'
Public Function myConvCifreLettere(ByVal nMyNumero As Double, ByVal strSeparatore As Variant, ByVal blnStile As Boolean) As String
Dim Virgola As Integer
Dim StrIntero As String
Dim Decimale As String

' Inizializza tabelle
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"

' converte numero in lettere
Virgola = InStr(1, Str$(nMyNumero), ".", 0)
StrIntero = Milioni_e_Migliaia(Int(nMyNumero))

If Not blnStile Then
    ' converte numero tutto in lettere
    If Virgola = 0 Then
             myConvCifreLettere = StrIntero
    Else
        Decimale = Milioni_e_Migliaia(Val(Mid$(Str$(nMyNumero), Virgola + 1, Len(StrIntero) - Virgola)))
        If Int(nMyNumero) = 0 Then
             myConvCifreLettere = "zero virgola " & Decimale
        Else
             If (Decimale = "") Then
                 myConvCifreLettere = StrIntero
             Else
                 myConvCifreLettere = StrIntero & " virgola " & Decimale
             End If
        End If
    End If
Else
    ' converte numero in lettere stile assegno
    myConvCifreLettere = StrIntero & strSeparatore & IIf(Virgola = 0, "00", Val(Mid$(Str$(nMyNumero), Virgola + 1, 2)))
    myConvCifreLettere = UCase(Left(myConvCifreLettere, 1)) & Right(myConvCifreLettere, Len(myConvCifreLettere) - 1)
End If

End Function

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
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))
        Unita = Numero Mod 10
        If Unita = 0 Then
             Decine_e_Unita = Decine
        Else
             Decine_e_Unita = Decine & Tabella_Nomi(Unita)
        End If
    End If
End If
End Function

Private Function Milioni_e_Migliaia(Numero As Double) As String
Dim Assoluto As Double
Dim NumMilioni As Double
Dim Milioni As String
Dim Var1 As Double, NumMigliaia As Double
Dim 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

Preso spunto dal sito della Microsoft, ho personalizzato la function sopra riportata inserendo una function richiamabile e parametrizzata per personalizzare lo stile della conversione da cifre in lettere e renderla più fruibile per scopi molteplici.

La demo presenta due possibili conversioni in stile assegno e tutto convertito in lettere come da originale esempio Microsoft. Evidenziata in rosso la function creata per personalizzare quanto detto.
http://myfreefilehosting.com/f/67f15b6d9f_0.21MB

Per utilizzare la function myConvCifreLettere, dopo aver inserito in un modulo il codice sopra riportato, sarà sufficiente richiamarla come riportato in questo esempio:

Private Sub nCifre_AfterUpdate()

' ESEMPIO 1
' converte cifre in lettere stile assegno
If Me.nCifre > 0 Then
    Me.txtNumero = myConvCifreLettere(Me.nCifre, "/", True)
Else
    Me.txtNumero = ""
End If

' ESEMPIO 2
' converte cifre in lettere - tutto in lettere
If Me.nCifre > 0 Then
    Me.txtNumero2 = myConvCifreLettere(Me.nCifre, "", False)
Else
    Me.txtNumero2 = ""
End If

End Sub

Nella speranza di aver dato un piccolo contributo per tutti, lascio come sempre al grande Greg di valutare se inserirla nella sezione delle demo.

Ciaooo

Edited by 65.franco

...acciderbolina ! 

                                        
                                  
                                    
                                 
                                
                                                                       
Come sempre.... "Alti Livelli"...
Grazie 65.Franco
Saluti
Libeccio865...over 


Edited by Libeccio865

Eh eh ... ti ringrazio... Qualcosa in più comincio a fare...
Diciamo che mi tolgo qualche soddisfazione ogni tanto...
E magari provo ad aiutare qualcuno che ha necessità... Ci provo...

Per il resto tutto ok... A parte il vento che comincia a tirare....
E se comincia di notte non è una bella cosa...
Sarà una lunga serata... (sono di guardia)

Access... Viva Access... Ma sarà forse il caso che passo al 2007????
Saluti...
Libeccio865...over