IALweb Homepage
Forum Home Forum Home > MS Office > Microsoft Office > Microsoft Access
  New Posts New Posts RSS Feed - Demo - Converte Numero da Cifre in Lettere
  FAQ FAQ  Forum Search   Events   Register Register  Login Login


REGISTRATEVI su IALWeb forum!

Topic ClosedDemo - Converte Numero da Cifre in Lettere

 Post Reply Post Reply
Author
Message
65.franco View Drop Down
Utente Onorario
Utente Onorario
Avatar

Joined: 19/Apr/2009
Location: Italy
Status: Offline
Points: 4108
Direct Link To This Post Topic: Demo - Converte Numero da Cifre in Lettere
    Posted: 21/Feb/2010 at 00:01

' (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
Franco...
Back to Top
Sponsored Links


Back to Top
Impero View Drop Down
Utente Base
Utente Base


Joined: 21/Mag/2009
Location: Italy
Status: Offline
Points: 82
Direct Link To This Post Posted: 21/Feb/2010 at 11:34
un grazie ed un applauso per quanto messo ha disposizione
Maurizio
Back to Top
Tommy_G View Drop Down
Veterano
Veterano
Avatar

Joined: 15/Mag/2007
Status: Offline
Points: 1470
Direct Link To This Post Posted: 21/Feb/2010 at 12:28
...acciderbolina ! 
Back to Top
65.franco View Drop Down
Utente Onorario
Utente Onorario
Avatar

Joined: 19/Apr/2009
Location: Italy
Status: Offline
Points: 4108
Direct Link To This Post Posted: 21/Feb/2010 at 15:48

Ragazzi ... grazie di cuore....
ho comunque solo preso un vecchio metodo descritto in microsoft e ho cercato di renderlo il più fruibile possibile anche per coloro che non masticano di vba...

Grazie ancora...    ciaooo

Franco...
Back to Top
Libeccio865 View Drop Down
Veterano
Veterano
Avatar

Joined: 03/Dic/2008
Status: Offline
Points: 1442
Direct Link To This Post Posted: 21/Feb/2010 at 18:22
                                        
                                  
                                    
                                 
                                
                                                                       
Come sempre.... "Alti Livelli"...
Grazie 65.Franco
Saluti
Libeccio865...over 


Edited by Libeccio865


Se le cose sembrano andar meglio, c'è qualcosa di cui non stiamo tenendo conto.
Back to Top
65.franco View Drop Down
Utente Onorario
Utente Onorario
Avatar

Joined: 19/Apr/2009
Location: Italy
Status: Offline
Points: 4108
Direct Link To This Post Posted: 21/Feb/2010 at 18:54

Troppo buono Libeccio.... questa è solo piccola cosa 

Ma da te invece che vento tira ?
noto con molto piacere che hai fatto strepitosi progressi... sinceri complimenti
(altri invece trattano questo povero access peggio di una zappa )

Ciaooo

Franco...
Back to Top
Libeccio865 View Drop Down
Veterano
Veterano
Avatar

Joined: 03/Dic/2008
Status: Offline
Points: 1442
Direct Link To This Post Posted: 21/Feb/2010 at 19:37
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


Se le cose sembrano andar meglio, c'è qualcosa di cui non stiamo tenendo conto.
Back to Top
65.franco View Drop Down
Utente Onorario
Utente Onorario
Avatar

Joined: 19/Apr/2009
Location: Italy
Status: Offline
Points: 4108
Direct Link To This Post Posted: 21/Feb/2010 at 20:11

Se passi al 2007 Libeccio ti perderai un poco.... ma vedrai che non sarà poi così drammatico...  troverai molto giovamento in tante cose.
Ma poi in sostanza non cambia moltissimo se uno tiene in buon ordine tutte le cose che fa applicando le giuste regole di progettazione.

Poi da uno come te abituato a ben altri "venti"...  sarà veramente una passeggiata...come dire... 'una leggera brezza'

Buon lavoro ...  ciaooo   

Franco...
Back to Top
 Post Reply Post Reply
  Share Topic   

Forum Jump Forum Permissions View Drop Down

Forum Software by Web Wiz Forums® version 10.17
Copyright ©2001-2013 Web Wiz Ltd.

This page was generated in 0,063 seconds.