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