convertire numeri in lettere

[danielix05]

ciao,
uso stampa unione da tanto tempo ma ieri mi è venuto di pensare se fosse possibile
dato un campo tipo VALUTA convertirlo in lettere

quindi se sul foglio excel ho un campo con € 12,00 su word dovrebbe apparire "dodici"

grazie delle vostre indicazioni

[patel]

si fa con la seguente macro

Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1
Function Trasforma_Gruppo(s As String) As String

Dim Ris As String
Dim us  As String
Dim ds  As String
Dim cs  As String

         u = Mid$(s, 3, 1)
         d = Mid$(s, 2, 1)
         c = Mid$(s, 1, 1)
         
         cs = ""
         ds = ""
         us = ""
                  
         Select Case u  ' unità
                Case "1": us = "uno"
                Case "2": us = "due"
                Case "3": us = "tre"
                Case "4": us = "quattro"
                Case "5": us = "cinque"
                Case "6": us = "sei"
                Case "7": us = "sette"
                Case "8": us = "otto"
                Case "9": us = "nove"
         End Select
         
         Select Case d  ' decine
                Case "1": ds = "dieci"
                Case "2": ds = "venti"
                Case "3": ds = "trenta"
                Case "4": ds = "quaranta"
                Case "5": ds = "cinquanta"
                Case "6": ds = "sessanta"
                Case "7": ds = "settanta"
                Case "8": ds = "ottanta"
                Case "9": ds = "novanta"
         End Select
         
         Select Case c  ' centinaia
                Case "1": cs = "cento"
                Case "2": cs = "duecento"
                Case "3": cs = "trecento"
                Case "4": cs = "quattrocento"
                Case "5": cs = "cinquecento"
                Case "6": cs = "seicento"
                Case "7": cs = "settecento"
                Case "8": cs = "ottocento"
                Case "9": cs = "novecento"
         End Select
         
         If ds = "dieci" Then
            us = ""
            Select Case u
                   Case "1": ds = "undici"
                   Case "2": ds = "dodici"
                   Case "3": ds = "tredici"
                   Case "4": ds = "quattordici"
                   Case "5": ds = "quindici"
                   Case "6": ds = "sedici"
                   Case "7": ds = "diciassette"
                   Case "8": ds = "diciotto"
                   Case "9": ds = "diciannove"
            End Select
         End If
         If (ds <> "") And ((us = "uno") Or (us = "otto")) Then ds = Left$(ds, Len(ds) - 1)
         ' con uno e otto si elimina la vocale finale delle decine
         Ris = cs + ds + us
      
         Trasforma_Gruppo = Ris
End Function

Function Trasforma_in_lettere(n As Long) As String
Dim s As String
Dim ns As String
Dim grp1 As String
Dim grp2 As String
Dim grp3 As String
Dim grp4 As String
        
         ns = Str$(n)
         ns = Mid$(ns, 2)
         s = Left$("000000000000", 12 - Len(ns)) + ns
         
         grp1 = Trasforma_Gruppo(Right$(s, 3))
         grp2 = Trasforma_Gruppo(Mid$(s, 7, 1) + Mid$(s, 8, 1) + Mid$(s, 9, 1))
         grp3 = Trasforma_Gruppo(Mid$(s, 4, 1) + Mid$(s, 5, 1) + Mid$(s, 6, 1))
         grp4 = Trasforma_Gruppo(Left$(s, 3))
         
         If grp2 <> "" Then
            If grp2 = "uno" Then grp2 = "mille" Else grp2 = grp2 + "mila"
         End If
                  
         If grp3 <> "" Then
            If grp3 = "uno" Then grp3 = "unmilione" Else grp3 = grp3 + "milioni"
         End If
         
         If grp4 <> "" Then
            If grp4 = "uno" Then grp4 = "unmiliardo" Else grp4 = grp4 + "miliardi"
         End If
         
         Trasforma_in_lettere = grp4 + grp3 + grp2 + grp1
                                                     
End Function

e inserendo nella cella
=Trasforma_in_lettere(A4)

[danielix05]

caspita!!!

davvero notevole.
ho provato a testarla e mi dà

Errore di compilazione.
Previsto: Base oppure Compare oppure Explicit oppure Private

ho fatto due prove
1. mettendo =Trasforma_in_lettere(A4) in una colonna vicino a quella con i numeri in valuta (ovviamente mi sembra cretino ma l'ho fatto)

2. mettendo =Trasforma_in_lettere(A4) in una cella dove prima c'era un numero in valuta

si capisce che non ho le idee molto chiare...

che succede?

[luck]

bellina sta macro!

per farla girare in Excel elimina le prime due righe:

Rem Attribute VBA_ModuleType=VBAModule
Option VBASupport 1

[patel]

Chiedo scusa, ma l'ho copiata non da Excel , ma da OpenOffice. Può darsi che OO abbia aggiunto istruzioni sue.

[luck]

Originariamente inviato da patel
Chiedo scusa, ma l'ho copiata non da Excel , ma da OpenOffice. Può darsi che OO abbia aggiunto istruzioni sue.

ecco perchè...
non avevo mai visto quelle istruzioni in Excel...

Ma patel, te che ne sai, com'è integrazione di VBA in OpenOffice?
Girano bene le macro?
gli oggetti sono gli stessi di excel?

[patel]

Non sono un esperto, ho fatto e raccolto qualche macro quando lavoravo con excel e ora che uso Linux le ho trasportate così come sono su OpenOffice. Quelle vecchie funzionano, ma non sono riuscito a crearne di nuove, il linguaggio di default è completamente diverso e non ho approfondito più di tanto.
La conversione in lettere si trova facilmente in rete, basta cercare con google.

[luck]

ok, apriremo un topic magari a riguardo
intanto magari sentiamo danielix05 se ha risolto..

[danielix05]

Ciao ragazzi siete stati fantastici....

tutto va alla perfezione, ho seguito le indicazioni di luck e tutto funziona.

patel, hai proprio ragione, sulla rete si trova tutto... ma bisogna avere occhi per guardare...

io avevo cercato prima con "convertire numeri in lettere campi unione" ma mi venivano fuori sempre risultati non correlati in quanto il termine 'campo unione' collega il termine 'lettera' solo alle lettere epistolari

dopo la tua illuminazione ho cercato con "conversione numeri in lettere excel" e tutto ha preso un'altra piega.

spiegato l'arcano allora ho migliorato la ricerca in quanto la funzione che hai scritto non contempla, credo (!) i decimali.

io la devo utilizzare per stampare dei bollettini postali quindi passo questo codice.

salutissimi. daniele

[danielix05]

Option Base 1
Option Explicit
'Array contenente le lettere dei numeri
Dim Strconv(45) As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Name Function:     Public Function converti(strNumero)
'Author:            Emanuele Mattei
'Date Crated:       12/09/2004
'Last Modified:
'Description:       Converte i numeri in lettere

Public Function Converti(strNumero As String)
'variabile per l'importo
Dim CrrEuro As Currency
'centesimi
Dim IntCents As Integer
'variabile di tipo stringa per i centesimi
Dim StrCentesimi As String
'lettere dell'importo
Dim StrLettere As String

StrCentesimi = "00"
'Aggiornamento dello schermo attivato
Application.ScreenUpdating = True

'Imposto i valori dell'array

Strconv(1) = "uno"
Strconv(2) = "due"
Strconv(3) = "tre"
Strconv(4) = "quattro"
Strconv(5) = "cinque"
Strconv(6) = "sei"
Strconv(7) = "sette"
Strconv(8) = "otto"
Strconv(9) = "nove"
Strconv(10) = "dieci"
Strconv(11) = "undici"
Strconv(12) = "dodici"
Strconv(13) = "tredici"
Strconv(14) = "quattordici"
Strconv(15) = "quindici"
Strconv(16) = "sedici"
Strconv(17) = "diciasette"
Strconv(18) = "diciotto"
Strconv(19) = "diciannove"
Strconv(20) = "venti"
Strconv(21) = "ventuno"
Strconv(22) = "trenta"
Strconv(23) = "trentuno"
Strconv(24) = "quaranta"
Strconv(25) = "quarantuno"
Strconv(26) = "cinquanta"
Strconv(27) = "cinquantuno"
Strconv(28) = "sessanta"
Strconv(29) = "sessantuno"
Strconv(30) = "settanta"
Strconv(31) = "settantuno"
Strconv(32) = "ottanta"
Strconv(33) = "ottantuno"
Strconv(34) = "novanta"
Strconv(35) = "novantuno"
Strconv(36) = "cento"
Strconv(37) = "mille"
Strconv(38) = "mila"
Strconv(39) = "milione"
Strconv(40) = "milioni"
Strconv(41) = "miliardo"
Strconv(42) = "miliardi"
Strconv(43) = "centomila"

    'Verifico che ilvalore che sto convertendo sia numerico
    If Val(strNumero) = 0 Then
        MsgBox "La Cella selezionata non è un numero", vbInformation + vbOKOnly, "Shareoffice.it"
        Converti = "#Nome"
        Exit Function
    ElseIf Val(strNumero) > 999999999999# Then
        MsgBox "La Cella selezionata ha un valore maggiore di 999999999999 ", vbInformation + vbOKOnly, "Shareoffice.it"
        Converti = "#Nome"
        Exit Function
    
    End If

    'converto il numero in currency
    CrrEuro = CCur(strNumero)
   
    
    ' Formattazione dei centesimi
       StrCentesimi = Right(Format(strNumero, "##,##0.00"), 2)
    

    CrrEuro = Fix(CrrEuro)
    
    If CrrEuro < 21 Then
        StrLettere = num_venti(CLng(CrrEuro))
    ElseIf CrrEuro >= 21 And CrrEuro < 100 Then
        StrLettere = num_cento(CLng(CrrEuro))
    ElseIf CrrEuro >= 100 And CrrEuro < 1000 Then
        StrLettere = num_mille(CLng(CrrEuro))
    ElseIf CrrEuro >= 1000 And CrrEuro < 100000 Then
        StrLettere = num_centomila(CLng(CrrEuro), 0)
    ElseIf CrrEuro >= 100000 And CrrEuro < 1000000 Then
        StrLettere = num_milione(CLng(CrrEuro))
    ElseIf CrrEuro >= 1000000 And CrrEuro < 1000000000 Then
        StrLettere = num_miliardo(CLng(CrrEuro))
    'conversione per i miliardi
    ElseIf CrrEuro >= 1000000000 And CrrEuro < 1000000000000# Then
        StrLettere = num_miliardi(Format(CrrEuro, "##,##0"))
    End If
    'restituisco il valore
    Converti = StrLettere & "/" & StrCentesimi
End Function


Private Function num_venti(LngNum As Long)
    num_venti = Strconv(LngNum)
End Function

Private Function num_cento(LngNum As Long)
    Dim inNum1 As Integer
    Dim IntNum2 As Integer
    Dim StrLettera As String
    On Error GoTo errore
    If LngNum > 0 And LngNum < 21 Then
        num_cento = num_venti(LngNum)
    Else
        inNum1 = Int(LngNum / 10)
        If LngNum = 21 + (10 * (inNum1 - 2)) Then
            num_cento = Strconv((21 + (2 * (inNum1 - 2))))
        Else
            StrLettera = Strconv((20 + (2 * (inNum1 - 1) - 2)))
            IntNum2 = LngNum - (inNum1 * 10)
            If IntNum2 = 0 Then
            num_cento = StrLettera
            Else
             num_cento = StrLettera & Strconv(IntNum2)
            End If
           
        End If
    End If
    Exit Function
errore:
    MsgBox Err.Description, vbInformation, "num_cento"
    
End Function
'funzione mille
Private Function num_mille(LngNum As Long)
    Dim IntNum1 As Integer
    Dim IntNum2 As Integer
    Dim StrLettera As String
    On Error GoTo errore
    If LngNum = 100 Then
        num_mille = Strconv(36)
    ElseIf LngNum > 100 And LngNum < 200 Then
        IntNum1 = LngNum - 100
        StrLettera = Strconv(36)
        num_mille = StrLettera & num_cento(CLng(IntNum1))
    ElseIf LngNum >= 200 And LngNum < 1000 Then
        IntNum1 = Int(LngNum / 100)
        StrLettera = Strconv(IntNum1) & Strconv(36)
        IntNum2 = LngNum - (IntNum1 * 100)
        If LngNum <> 100 * IntNum1 Then
            num_mille = StrLettera & num_cento(CLng(IntNum2))
        Else
            num_mille = StrLettera
        End If
    End If
    Exit Function
errore:
    MsgBox Err.Description, vbInformation, "Num_mille"
End Function
'funzione che converto il testo dei centomila
Private Function num_centomila(LngNum As Long, flag As Boolean)
    Dim IntNum1 As Integer
    Dim lngNum2 As Long
    Dim StrLettera As String
    On Error GoTo errore
    IntNum1 = Int(LngNum / 1000)
    If IntNum1 = 1 And LngNum = 1000 Then
        If flag = 0 Then
            StrLettera = Strconv(37)
        Else
            StrLettera = Strconv(1)
            StrLettera = StrLettera & Strconv(38)
    
        End If
    ElseIf IntNum1 = 1 And LngNum <> 1000 Then
        If flag = 0 Then
            StrLettera = Strconv(37)
        Else
            StrLettera = Strconv(1)
            StrLettera = StrLettera & Strconv(38)
        End If
        lngNum2 = LngNum - 1000
        If lngNum2 < 100 Then
            StrLettera = StrLettera & num_cento(lngNum2)
        Else
            StrLettera = StrLettera & num_mille(lngNum2)
        End If
    
    ElseIf IntNum1 > 1 And IntNum1 <= 21 Then
        StrLettera = Strconv(IntNum1)
        StrLettera = StrLettera & Strconv(38)
        lngNum2 = LngNum - (IntNum1 * 1000)
        If lngNum2 >= 1 And lngNum2 < 100 Then
            StrLettera = StrLettera & num_cento(lngNum2)
        ElseIf lngNum2 >= 100 Then
            StrLettera = StrLettera & num_mille(lngNum2)
        End If
    ElseIf IntNum1 > 21 And IntNum1 < 100 Then
        StrLettera = num_cento(CLng(IntNum1))
        StrLettera = StrLettera & Strconv(38)
        lngNum2 = LngNum - (CLng(IntNum1) * 1000)
        If lngNum2 >= 1 And lngNum2 < 100 Then
            StrLettera = StrLettera & num_cento(lngNum2)
        ElseIf lngNum2 >= 100 Then
            StrLettera = StrLettera & num_mille(lngNum2)
        End If
    End If
    num_centomila = StrLettera
    Exit Function
errore:
    MsgBox Err.Description, vbInformation, "Num_centomila"
End Function

'funzione concerti in milioni
Private Function num_milione(LngNum As Long)
On Error GoTo errore
    Dim IntNum1 As Integer
    Dim lngNum2 As Long
    Dim StrLettera As String
    
    IntNum1 = Int(LngNum / 100000)
    If IntNum1 = 1 And LngNum = 100000 Then
        StrLettera = Strconv(43)
    ElseIf IntNum1 = 1 And LngNum <> 100000 Then
        StrLettera = Strconv(36)
        lngNum2 = LngNum - 100000
        If lngNum2 >= 1 And lngNum2 < 100 Then
        StrLettera = StrLettera & Strconv(38)
        StrLettera = StrLettera & num_cento(CLng(lngNum2))
        ElseIf lngNum2 >= 100 And lngNum2 < 1000 Then
        StrLettera = StrLettera & Strconv(38)
        StrLettera = StrLettera & num_mille(CLng(lngNum2))
        Else
        StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1)
        End If
    ElseIf IntNum1 > 1 Then
        StrLettera = Strconv(IntNum1)
        StrLettera = StrLettera & Strconv(36)
        lngNum2 = LngNum - (100000 * IntNum1)
        If lngNum2 > 0 And lngNum2 < 22 Then
            StrLettera = StrLettera & Strconv(38)
            StrLettera = StrLettera & num_venti(CLng(lngNum2))
        ElseIf lngNum2 >= 22 And lngNum2 < 1000 Then
            StrLettera = StrLettera & Strconv(38)
            StrLettera = StrLettera & num_mille(CLng(lngNum2))
        Else
            StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1)
        End If
    End If
    num_milione = StrLettera
    Exit Function
    
errore:
    MsgBox Err.Description, vbInformation, "Num_milione"
End Function
'Funzione che converti gli importi sotto al 999.999.999
Private Function num_miliardo(LngNum As Long)
    Dim IntNum1 As Integer
    Dim lngNum2 As Long
    Dim StrLettera As String
    On Error GoTo errore
    IntNum1 = Int(LngNum / 1000000)
    If IntNum1 = 1 And LngNum = 1000000 Then
        StrLettera = "un" & Strconv(39)
    ElseIf IntNum1 = 1 And LngNum <> 1000000 Then
        StrLettera = "un" & Strconv(39)
        lngNum2 = LngNum - 1000000
        If lngNum2 >= 1 And lngNum2 < 100 Then
            StrLettera = StrLettera & num_cento(CLng(lngNum2))
        ElseIf lngNum2 >= 100 And lngNum2 < 1000 Then
            StrLettera = StrLettera & num_mille(CLng(lngNum2))
        Else
            StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1)
        End If
    ElseIf IntNum1 > 1 Then
        If IntNum1 > 21 And IntNum1 < 100 Then
            StrLettera = num_cento(CLng(IntNum1))
        ElseIf IntNum1 >= 100 And IntNum1 < 1000 Then
            StrLettera = num_mille(CLng(IntNum1))
        Else
            StrLettera = Strconv(CLng(IntNum1))
        End If
            StrLettera = StrLettera & Strconv(40)
            lngNum2 = LngNum - (1000000 * IntNum1)
        If lngNum2 >= 1 And lngNum2 < 100 Then
            StrLettera = StrLettera & num_cento(CLng(lngNum2))
        ElseIf lngNum2 >= 100 And lngNum2 < 1000 Then
            StrLettera = StrLettera & num_mille(CLng(lngNum2))
        ElseIf lngNum2 >= 1000 And lngNum2 < 100000 Then
            StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1)
        Else
            StrLettera = StrLettera & num_milione(CLng(lngNum2))
        End If
    End If
    num_miliardo = StrLettera
    Exit Function
errore:
    MsgBox Err.Description, vbInformation, "Num_miliardo"
End Function

'Converte gli importi sotto i 999.999.999.999
Private Function num_miliardi(LngNum As Currency)
    Dim IntNum1 As Integer
    Dim lngNum2 As Long
    'variabile per il calcolo della differnza
    Dim CrrTemporaneo As Currency
    
    Dim StrLettera As String
    On Error GoTo errore
    IntNum1 = Int(LngNum / 1000000000)
    If IntNum1 = 1 And LngNum = 1000000000 Then
        StrLettera = "un" & Strconv(41)
    ElseIf IntNum1 = 1 And LngNum <> 1000000000 Then
        StrLettera = "un" & Strconv(41)
        lngNum2 = LngNum - 1000000000
        If lngNum2 >= 1 And lngNum2 < 100 Then
            StrLettera = StrLettera & num_cento(CLng(lngNum2))
        ElseIf lngNum2 >= 100 And lngNum2 < 1000 Then
            StrLettera = StrLettera & num_mille(CLng(lngNum2))
        ElseIf lngNum2 >= 100000 And lngNum2 < 1000000000 Then
            StrLettera = StrLettera & num_miliardo(lngNum2)
        Else
            StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1)
        End If
    ElseIf IntNum1 > 1 Then
        If IntNum1 > 21 And IntNum1 < 100 Then
            StrLettera = num_cento(CLng(IntNum1))
        ElseIf IntNum1 >= 100 And IntNum1 < 1000 Then
            StrLettera = num_mille(CLng(IntNum1))
        Else
            StrLettera = Strconv(CLng(IntNum1))
        End If
            StrLettera = StrLettera & Strconv(42)
            'lo valorizzo con il valore di un miliardo
            CrrTemporaneo = 1000000000
            CrrTemporaneo = CrrTemporaneo * IntNum1
            
            lngNum2 = LngNum - CrrTemporaneo
        If lngNum2 >= 1 And lngNum2 < 100 Then
            StrLettera = StrLettera & num_cento(CLng(lngNum2))
        ElseIf lngNum2 >= 100 And lngNum2 < 1000 Then
            StrLettera = StrLettera & num_mille(CLng(lngNum2))
        ElseIf lngNum2 >= 1000 And lngNum2 < 100000 Then
            StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1)
        ElseIf lngNum2 >= 100000 And lngNum2 < 1000000000 Then
            StrLettera = StrLettera & num_miliardo(lngNum2)
        Else
            StrLettera = StrLettera & num_milione(CLng(lngNum2))
        End If
    End If
    num_miliardi = StrLettera
    Exit Function
errore:
    MsgBox Err.Description, vbInformation, "Num_miliardi"
End Function

che, da un campo numerico € 1.250,45, restituisce milleduecentocinquanta/45

è fantastico no???

ah: nella cella excel va scritto =converti(C5)