VBA convertir un nombre en toutes lettres
Résolu
lolokiller91
Messages postés
103
Date d'inscription
Statut
Membre
Dernière intervention
-
Patrice33740 Messages postés 8561 Date d'inscription Statut Membre Dernière intervention -
Patrice33740 Messages postés 8561 Date d'inscription Statut Membre Dernière intervention -
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 :
C'est parceque j'ai vraiment beaucoup de variables auxquels je dois faire cet opérations =S
Merci d'avance
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
A voir également:
- VBA convertir un nombre en toutes lettres
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Convertir epub en kindle - Guide
- Convertir youtube en mp3 avec audacity - Guide
- Convertir kindle en epub - Guide
3 réponses
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
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
Bekkar,
Ce code ne respecte aucune des règles de l'orthographe française des nombres !
Je trouve très cavalier de venir polluer une discussion déjà résolue sans apporter une quelconque amélioration !
Tu devrait regarder le code de Lermitte222 pour te rendre compte du chemin qu'il te reste à parcourir.
Patrice
Ce code ne respecte aucune des règles de l'orthographe française des nombres !
Je trouve très cavalier de venir polluer une discussion déjà résolue sans apporter une quelconque amélioration !
Tu devrait regarder le code de Lermitte222 pour te rendre compte du chemin qu'il te reste à parcourir.
Patrice
Merci quand même
Il existe, peut être dans une API ou librairie une fonction qui retourne un nombre en chiffre ou l'inverse, quoi qu'il en soit, dans cette API ou libraire, il y a du code qui dit que pour tel nombre, il faut retourner tel chiffre.
;o)