VBA convertir un nombre en toutes lettres Résolu/Fermé

Question

Bonjour,   

Existe-t-il une fonction qui peut convertir une variable integer en une variables string contenant le même nombre écrit en toutes lettres ?  

Du genre :  

Dim Nombre As Integer  
Dim LeNombreEnToutesLettres As String  
Nombre = 12  
LeNombreEnToutesLettres = LaFonctionQueJeCherche(Nombre)  
'Grâce à cette fonction la variable LeNombreEnToutesLettres est égale à "douze"  

C'est parceque j'ai vraiment beaucoup de variables auxquels je dois faire cet opérations =S  

Merci d'avance

Polux31 · Answer

Bonjour,

Tout est dit ici sur le forum.

;o)

Patrice33740 · Answer

Regarde aussi :
https://forums.commentcamarche.net/forum/affich-1237557-convertir-un-chiffre-en-lettre-avec-excel

Bekkar · Answer

Voici, en VBasic une macro pour convertir les montants en toute lettre. Cela peut être amélioré. Ce code est initialement réaliser pour convertir des montants, placés dans un champs de formulaire word, en toute lettre et son placement dans un autre champs. Le Champs de type nombre appelé "TheAmount" est lu et converti en toute lettre dans la monnaie placé dans le champs "Money", le résultat est placé dans le champs "Libelle". Evidemment, vous pouvez modifier le code pour retourner le resultat dans une autre variable. Le Code : Sub GatherAmount(TheAmount As Double, Millions, Thaousands, Dinars, Centimes As Integer) Dim IntAmount As Long IntAmount = Fix(TheAmount): Centimes = (TheAmount - Fix(TheAmount)) * 100 Dinars = IntAmount Mod 1000: IntAmount = Fix(IntAmount / 1000) Thaousands = IntAmount Mod 1000: IntAmount = Fix(IntAmount / 1000) Millions = IntAmount Mod 1000 End Sub Sub GatherNumber(ANumber As Integer, AUnit, ATens, AHundreds As Integer) AUnit = ANumber Mod 10 ATens = Fix(ANumber / 10) Mod 10 AHundreds = Fix(ANumber / 100) Mod 10 End Sub Function TellUnities(ANumber As Integer) As String Dim TxtNumbers As Variant TxtNumbers = Array("", "Un", "Deux", "Trois", "Quatre", "Cinq", "Six", "Sept", "Huit", "Neuf") TellUnities = TxtNumbers(ANumber) End Function Function TellTeens(AUnit As Integer) As String Dim TxtTeens As Variant TxtTeens = Array("Dix", "Onze", "Douze", "Treize", "Quatorze", "Quinze", "Seize", "Dix Sept", "Dix Huit", "Dix Neuf") TellTeens = TxtTeens(AUnit) End Function Function TellTens(ATens As Integer) As String Dim TxtTens As Variant TxtTens = Array("", "", "Vingt", "Trente", "Quarante", "Cinquante", "Soixante", "Soixante Dix", "Quatre Vingt", "Quatre Vingt Dix") TellTens = TxtTens(ATens) End Function Function Epelle(AnAmount As Integer, TellOne As Boolean, TellSuffix As Boolean, Suffix As String) As String Dim SUnities As Integer Dim STens As Integer Dim SHandreds As Integer Dim SpellAmount As String Dim ASuffix As String ASuffix = "" If AnAmount <> 0 Or TellSuffix Then ASuffix = " " + Suffix + " " Call GatherNumber(AnAmount, SUnities, STens, SHandreds) SpellAmount = "" 'Les centaines If SHandreds <> 0 Then Select Case SHandreds Case 1 SpellAmount = SpellAmount + "Cent " Case 2 To 9 SpellAmount = SpellAmount + TellUnities(SHandreds) + " Cent " End Select End If 'Les dizaines If STens <> 0 Then Select Case STens Case 1 SpellAmount = SpellAmount + TellTeens(SUnities) Case 2, 3, 4, 5, 6, 8 SpellAmount = SpellAmount + TellTens(STens) + " " + TellUnities(SUnities) Case 7, 9 SpellAmount = SpellAmount + TellTens(STens - 1) + " " + TellTeens(SUnities) End Select End If ' Les Unités If SUnities <> 0 Then If STens = 0 Then If SUnities = 1 Then If TellOne Or SHandreds <> 0 Then SpellAmount = SpellAmount + " " + TellUnities(SUnities) End If Else SpellAmount = SpellAmount + " " + TellUnities(SUnities) End If End If End If SpellAmount = SpellAmount + ASuffix Epelle = SpellAmount End Function Function SpellIt(AnAmount As Double, AMoney As String) As String Dim Mill As Integer Dim Thao As Integer Dim Dina As Integer Dim Cent As Integer Dim SaySuffix As Boolean Call GatherAmount(AnAmount, Mill, Thao, Dina, Cent) SaySiffix = Mill <> 0 Or Thao <> 0 Or Dina <> 0 SpellIt = Epelle(Mill, True, Mill <> 0, "Million") + _ Epelle(Thao, False, Thao <> 0, "Mille") + _ Epelle(Dina, True, True, AMoney) + _ Epelle(Cent, True, Cent <> 0, "Centimes") End Function Sub Libeller() ' ' Libeller Macro ' ' Dim Amount As Double Dim Money As String Dim Spling As String 'Récupérer les valeurs des paramètres Money = ActiveDocument.FormFields("Money").Result 'la monnaie Amount = ActiveDocument.FormFields("Amount").Result 'le montant Spling = SpellIt(Amount, Money) 'Libeller le montant Amount dans la monnaie Money 'Affecter la valeur ActiveDocument.FormFields("Libelle").Result = Spling End Sub Sub CalDates() Dim LetterOfCreditDate As Date Dim ExpireDate As Date Dim UlDateOfExp As Date LetterOfCreditDate = ActiveDocument.FormFields("DateOfLC").Result ExpireDate = LetterOfCreditDate + 90 ' ExpireDate = ActiveDocument.FormFields("DateOfExpiry").Result ActiveDocument.FormFields("DateOfExpiry").Result = ExpireDate UlDateOfExp = ExpireDate - 21 ActiveDocument.FormFields("UltimateDate").Result = UlDateOfExp End Sub

VBA convertir un nombre en toutes lettres

3 réponses

Discussions similaires