Translation automatique d'une colonne de chiffres en colonne voisine en lettres [Résolu]

forys - 15 août 2012 à 18:52 - Dernière réponse : cs_Le Pivert 5450 Messages postés jeudi 13 septembre 2007Date d'inscriptionContributeurStatut 18 octobre 2018 Dernière intervention
- 16 août 2012 à 14:35
bonjour,
pour une oeuvre humanitaire dont je suis le tresorier je voudrais dans une feuille excel mettre dans une colonne le montant des dons et que ces montants apparaissent dans la colonne suivante directement en lettres.
Est ce possible?Comment faire?
merci pour votre aide
Afficher la suite 

Votre réponse

3 réponses

Meilleure réponse
Utilisateur anonyme - 15 août 2012 à 19:08
3
Merci
Bonsoir,

On trouve des tas de choses sur la toile comme ici

Merci Utilisateur anonyme 3

Avec quelques mots c'est encore mieux Ajouter un commentaire

Codes Sources a aidé 98 internautes ce mois-ci

Commenter la réponse de Utilisateur anonyme
Utilisateur anonyme - 16 août 2012 à 02:10
0
Merci
Bonjour,

Pour VBA, il y a une section Officielle dans la section VB6. Le chemin se termine par langages dérivés/VBA

Tu peux aussi utiliser le nec plus ultra de la chose en question (Faut bien que je me fasse un peu de publicité) en cliquant ici.

Ensuite tu choisis le zip (Nb2Words.zip) ou l'exécutable (Nb2Words.exe).
Si mes souvenirs sont exacts, les projets sont protégés par un mot de passe. Toujours si mes souvenirs sont exacts, tu peux le trouver avec un clic-droit et les propriétés.

Il y a 3 versions Excel, Word et PowerPoint.
Commenter la réponse de Utilisateur anonyme
cs_Le Pivert 5450 Messages postés jeudi 13 septembre 2007Date d'inscriptionContributeurStatut 18 octobre 2018 Dernière intervention - 16 août 2012 à 14:35
0
Merci
Bonjour,
En prenant comme exemple le code source:

http://www.vbfrance.com/codes/EXCEL-CHIFFRE-LETTRE-VIRGULE_54315.aspx

mettre ce code dans la feuille active:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
 On Error Resume Next
 ActiveCell.Offset(0, 1).Value = ConvNumberLetter(Target.Value)
Worksheets("Feuil1").Columns("B:B").Columns.AutoFit 'colonne autoresize
End Sub
Public Function ConvNumberLetter(Nombre As Double, Optional Devise As Byte 0, Optional Langue As Byte 0) As String
Dim dblEnt As Variant, byDec As Byte
Dim bNegatif As Boolean
Dim strDev As String, strCentimes As String
 
    If Nombre < 0 Then
        bNegatif = True
        Nombre = Abs(Nombre)
    End If
    dblEnt = Int(Nombre)
    byDec = CInt((Nombre - dblEnt) * 100)
    If byDec = 0 Then
        If dblEnt > 999999999999999# Then
            ConvNumberLetter = "#TropGrand"
            Exit Function
        End If
    Else
        If dblEnt > 9999999999999.99 Then
            ConvNumberLetter = "#TropGrand"
            Exit Function
        End If
    End If
    Select Case Devise
        Case 0
            If byDec > 0 Then strDev = " francs et "
        Case 1
            strDev = " Euro"
            If dblEnt >1000000 And Right$(dblEnt, 6) "000000" Then strDev = " d'Euro"
            If byDec > 0 Then strCentimes = strCentimes & " Cent"
            If byDec > 1 Then strCentimes = strCentimes & "s"
        Case 2
            strDev = " Dollar"
            If byDec > 0 Then strCentimes = strCentimes & " Cent"
    End Select
    If dblEnt > 1 And Devise <> 0 Then strDev = strDev & "s"
    strDev = strDev & " "
    If dblEnt = 0 Then
        ConvNumberLetter = "zéro " & strDev
    Else
        ConvNumberLetter = ConvNumEnt(CDbl(dblEnt), Langue) & strDev
    End If
    If byDec = 0 Then
        If Devise <> 0 Then ConvNumberLetter = ConvNumberLetter & "zéro Cent"
    Else
        If Devise = 0 Then
            ConvNumberLetter = ConvNumberLetter & _
                               ConvNumDizaine(byDec, Langue, True) & strCentimes
        Else
            ConvNumberLetter = ConvNumberLetter & _
                               ConvNumDizaine(byDec, Langue, False) & strCentimes
        End If
    End If
    ConvNumberLetter = Replace(ConvNumberLetter, "  ", " ")
    If Left(ConvNumberLetter, 1) " " Then ConvNumberLetter _
       Right$(ConvNumberLetter, Len(ConvNumberLetter) - 1)
    If Right$(ConvNumberLetter, 1) " " Then ConvNumberLetter _
       Left(ConvNumberLetter, Len(ConvNumberLetter) - 1)
End Function
 
Private Function ConvNumEnt(Nombre As Double, Langue As Byte)
Dim iTmp As Variant, dblReste As Double
Dim strTmp As String
Dim iCent As Integer, iMille As Integer, iMillion As Integer
Dim iMilliard As Integer, iBillion As Integer
 
    iTmp = Nombre - (Int(Nombre / 1000) * 1000)
    iCent = CInt(iTmp)
    ConvNumEnt = Nz(ConvNumCent(iCent, Langue))
    dblReste = Int(Nombre / 1000)
    If iTmp 0 And dblReste 0 Then Exit Function
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    If iTmp 0 And dblReste 0 Then Exit Function
    iMille = CInt(iTmp)
    strTmp = ConvNumCent(iMille, Langue)
    Select Case iTmp
        Case 0
        Case 1
            strTmp = " mille "
        Case Else
            strTmp = strTmp & " mille "
    End Select
    If iMille 0 And iCent > 0 Then ConvNumEnt "et " & ConvNumEnt
    ConvNumEnt = Nz(strTmp) & ConvNumEnt
    dblReste = Int(dblReste / 1000)
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    If iTmp 0 And dblReste 0 Then Exit Function
    iMillion = CInt(iTmp)
    strTmp = ConvNumCent(iMillion, Langue)
    Select Case iTmp
        Case 0
        Case 1
            strTmp = strTmp & " million "
        Case Else
            strTmp = strTmp & " millions "
    End Select
    If iMille 1 Then ConvNumEnt "et " & ConvNumEnt
    ConvNumEnt = Nz(strTmp) & ConvNumEnt
    dblReste = Int(dblReste / 1000)
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    If iTmp 0 And dblReste 0 Then Exit Function
    iMilliard = CInt(iTmp)
    strTmp = ConvNumCent(iMilliard, Langue)
    Select Case iTmp
        Case 0
        Case 1
            strTmp = strTmp & " milliard "
        Case Else
            strTmp = strTmp & " milliards "
    End Select
    If iMillion 1 Then ConvNumEnt "et " & ConvNumEnt
    ConvNumEnt = Nz(strTmp) & ConvNumEnt
    dblReste = Int(dblReste / 1000)
    iTmp = dblReste - (Int(dblReste / 1000) * 1000)
    If iTmp 0 And dblReste 0 Then Exit Function
    iBillion = CInt(iTmp)
    strTmp = ConvNumCent(iBillion, Langue)
    Select Case iTmp
        Case 0
        Case 1
            strTmp = strTmp & " billion "
        Case Else
            strTmp = strTmp & " billions "
    End Select
    If iMilliard 1 Then ConvNumEnt "et " & ConvNumEnt
    ConvNumEnt = Nz(strTmp) & ConvNumEnt
End Function
 
Private Function ConvNumDizaine(Nombre As Byte, Langue As Byte, bDec As Boolean) As String
Dim TabUnit As Variant, TabDiz As Variant
Dim byUnit As Byte, byDiz As Byte
Dim strLiaison As String
 
    If bDec Then
        TabDiz = Array("zéro", "", "vingt", "trente", "quarante", "cinquante", _
                       "soixante", "soixante", "quatre-vingt", "quatre-vingt")
    Else
        TabDiz = Array("", "", "vingt", "trente", "quarante", "cinquante", _
                       "soixante", "soixante", "quatre-vingt", "quatre-vingt")
    End If
    If Nombre = 0 Then
        TabUnit = Array("zéro")
    Else
        TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
                        "huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", _
                        "seize", "dix-sept", "dix-huit", "dix-neuf")
    End If
    If Langue = 1 Then
        TabDiz(7) = "septante"
        TabDiz(9) = "nonante"
    ElseIf Langue = 2 Then
        TabDiz(7) = "septante"
        TabDiz(8) = "huitante"
        TabDiz(9) = "nonante"
    End If
    byDiz = Int(Nombre / 10)
    byUnit = Nombre - (byDiz * 10)
    strLiaison = "-"
    If byUnit 1 Then strLiaison " et "
    Select Case byDiz
        Case 0
            strLiaison = " "
        Case 1
            byUnit = byUnit + 10
            strLiaison = ""
        Case 7
            If Langue 0 Then byUnit byUnit + 10
        Case 8
            If Langue <> 2 Then strLiaison = "-"
        Case 9
            If Langue = 0 Then
                byUnit = byUnit + 10
                strLiaison = "-"
            End If
    End Select
    ConvNumDizaine = TabDiz(byDiz)
    If byDiz 8 And Langue <> 2 And byUnit 0 Then ConvNumDizaine = ConvNumDizaine & "s"
    If TabUnit(byUnit) <> "" Then
        ConvNumDizaine = ConvNumDizaine & strLiaison & TabUnit(byUnit)
    Else
        ConvNumDizaine = ConvNumDizaine
    End If
End Function
 
Private Function ConvNumCent(Nombre As Integer, Langue As Byte) As String
Dim TabUnit As Variant
Dim byCent As Byte, byReste As Byte
Dim strReste As String
 
    TabUnit = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
                    "huit", "neuf", "dix")
    byCent = Int(Nombre / 100)
    byReste = Nombre - (byCent * 100)
    strReste = ConvNumDizaine(byReste, Langue, False)
    Select Case byCent
        Case 0
            ConvNumCent = strReste
        Case 1
            If byReste = 0 Then
                ConvNumCent = "cent"
            Else
                ConvNumCent = "cent " & strReste
            End If
        Case Else
            If byReste = 0 Then
                ConvNumCent = TabUnit(byCent) & " cents"
            Else
                ConvNumCent = TabUnit(byCent) & " cent " & strReste
            End If
    End Select
End Function
 Private Function Nz(strNb As String) As String
    If strNb <> " zéro" Then Nz = strNb
End Function




@+Le Pivert
Commenter la réponse de cs_Le Pivert

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.