Diconsi: converti numeri

Hai un problema con Excel?

Nuova discussione

Diconsi: converti numeri
di Nabba_72 (utente non iscritto) data: 23/02/2011
Ciao a tutti,
ho questo problema: in excell 2003 utilizzavo la routine di seguito per convertire i numeri in lettere. ad esempio "17,95€" venivano convertiti in "diciassette/95 euro".
la macro funzionava benissimo fino a quando non abbiamo fatto l'upgrade a excell 2007. ora non funziona più!
qualcuno riesce a dirmi dov'è l'errore?
grazie

Option Base 1
Option Explicit

'Array contenente le lettere dei numeri
Dim Strconv(0 To 45) As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Name Function:     Public Function converti(strNumero)
'Author:            ... ....
'Date Crated:       17/11/2010
'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
'centesimi


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

'Imposto i valori dell'array
Strconv(0) = "zero"
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 And IsNumeric(Strnumero) = False 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)
    
    'testo per centesimi
    
    If CInt(StrCentesimi) < 21 And CInt(StrCentesimi) > 0 Then
        StrCentesimi = num_venti(CLng(StrCentesimi))
    ElseIf CInt(StrCentesimi) >= 21 And CInt(StrCentesimi) < 100 Then
        StrCentesimi = num_cento(CLng(StrCentesimi))
    End If
    
    
    
    
    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
    StrLettera = "mila"
    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))
            'nuova modifica
        ElseIf lngNum2 >= 1000 And lngNum2 < 100000 Then
            StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1)
        Else
             StrLettera = StrLettera & num_milione(CLng(lngNum2))
        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

di Albatros54 (utente non iscritto) data: 23/02/2011
In excel 2007 gia c'e' una funzione che si chiama converti, rinomina la tua funzione in converti2 o altro nome.
ciao
albatros54
di Albatros54 (utente non iscritto) data: 23/02/2011
Dimenticavo, devi rinominare con il nuovo nome anche tutte le varie chiamate con il vecchio nome tipo:
converti = "(" & strlettere & "/" & strcentesimi & ")"
diventa:
converti2 = "(" & strlettere & "/" & strcentesimi & ")"
ciao
albatros54

di Nabba72 (utente non iscritto) data: 24/02/2011
Gentilissimo albatros,
ho provato a fare come hai detto, però ho sostituito la "chiamata" converti con diconsi per evitare doppioni. dal foglio di calcolo provo ad inserire la formula =diconsi(nomecella)ma ottengo come risultato #nome?
dove ho sbagliato? cosa non ho fatto?
grazie ancora.

Option Base 1
Option Explicit

'Array contenente le lettere dei numeri
Dim Strconv(0 To 45) As String
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Name Function:     Public Function diconsi(strNumero)
'Author:            ... ...
'Date Crated:       17/11/2010
'Last Modified:
'Description:       Converte i numeri in lettere
Public Function diconsi(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
'centesimi


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

'Imposto i valori dell'array
Strconv(0) = "zero"
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 And IsNumeric(Strnumero) = False Then
        MsgBox "La Cella selezionata non è un numero", vbInformation + vbOKOnly, "Shareoffice.it"
        diconsi = "#Nome"
        Exit Function
    ElseIf Val(Strnumero) > 999999999999# Then
        MsgBox "La Cella selezionata ha un valore maggiore di 999999999999 ", vbInformation + vbOKOnly, "Shareoffice.it"
        diconsi = "#Nome"
        Exit Function
    
    End If

    'converto il numero in currency
    CrrEuro = CCur(Strnumero)
   
    
    ' Formattazione dei centesimi
     StrCentesimi = Right(Format(Strnumero, "##,##0.00"), 2)
    
    'testo per centesimi
    
    If CInt(StrCentesimi) < 21 And CInt(StrCentesimi) > 0 Then
        StrCentesimi = num_venti(CLng(StrCentesimi))
    ElseIf CInt(StrCentesimi) >= 21 And CInt(StrCentesimi) < 100 Then
        StrCentesimi = num_cento(CLng(StrCentesimi))
    End If
    
    
    
    
    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
    diconsi = "(" & 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
    StrLettera = "mila"
    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 converte 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))
            'nuova modifica
        ElseIf lngNum2 >= 1000 And lngNum2 < 100000 Then
            StrLettera = StrLettera & num_centomila(CLng(lngNum2), 1)
        Else
             StrLettera = StrLettera & num_milione(CLng(lngNum2))
        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

di Albatros54 (utente non iscritto) data: 24/02/2011
Ciao nabba72
ho provato la funzione con il nome modificato da te, funziona tutto alla perfezione sia con excel 2007 che con 2010. non so che dirti
ciao
albatros54
di Nabba72 (utente non iscritto) data: 02/03/2011
Ciao albatros!
effettivamente il vba funziona ma solamente se lo copio come modulo nel foglio di lavoro, mentre io vorrei tenerlo nel personal.xlsb ed utilizzarlo ogni qual volta ne ho bisogno.
di Albatros54 (utente non iscritto) data: 02/03/2011
Allora : apri un file nuovo
vba in un modulo incolla la procedura diconsi
salva il file come "componente aggiuntivo di excel"
estensione e' xla.
prendi questo file e lo inserisci nella directory di office12(nel mio caso),xlstart.
quando aprirai qualsiasi file di excel , vai nel finestra funzioni, definite utente e troverai la tua funzione diconsi!!
ciao
alabtros54
di Nabba72 (utente non iscritto) data: 03/03/2011

ok perfetto
grazie ancora

Vuoi Approfondire?