Résolu convertir un nombre en numérique en Visual Basic

  • Auteur de la discussion Rose96
  • Date de début

Rose96

Nouveau membre
bonjour j'aimairai solliciter de votre aide, je ne suis qu'une débutante en Visual Basic, voici ma question: existe t-il une fonction qui permet de convertir un nombre numérique en toute lettres?? par exemple si on tape 1000 qu'il nous affiche mille
 

magellan

Modérâleur
Staff
par exemple:
1000->mille
1200->Mille deux cents
Il me semble que non, et que tu doives la programmer hélas.
 

magellan

Modérâleur
Staff
Meilleure réponse
En faisant une méthode spécifique qui reçoit le numérique, et retourne en texte.

Alors en gros, tu vas devoir analyser la valeur de la manière suivante:
mettre en texte les textes dans un tableau
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
 
Vous devez vous inscrire ou vous connecter pour répondre ici.
Derniers messages publiés
Statistiques globales
Discussions
730 128
Messages
6 717 846
Membres
1 586 373
Dernier membre
https://forum.tomshardwar
Partager cette page
Haut