VBA convertir un nombre en toutes lettres

Bonjour,

Tout est dit ici sur le forum.

;o)

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

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