Probleme avec numerotation dans VBA
M
Salut , voici mon probleme ..quand je tape 1000 bien sa ecris UN mille j'aimerais que sa ecrit seulement Mille. voici le lien du fichier complet vue qu'il est trop gros pour le site.
https://www.dropbox.com/s/p7rhba730yxgs52/Cheque%20Print%20vers%202%20-%20Copy.xls?dl=0
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Mille "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Dollars
Case ""
Dollars = "Zero "
Case "One"
Dollars = "Un "
Case Else
Dollars = Dollars & " Dollars "
End Select
Select Case Cents
Case ""
Cents = " et zero sous"
Case "One"
Cents = " et un sous"
Case Else
Cents = "et " & Cents & " sous"
End Select
SpellNumber = Dollars & Cents
End Function
' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
Dim hundred As Byte
hundred = Left(MyNumber, 1)
If hundred <> "0" Then
Select Case hundred
Case 1: Result = " Cent "
Case Else: Result = GetDigit(Mid(MyNumber, 1, 1)) & " Cents "
End Select
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function
' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
Dim x As Byte
x = Val(Left(TensText, 1))
If x = 1 Or x = 7 And x = 9 Then ' If value between 10-19...
Select Case Val(TensText)
Case 10: Result = "Dix"
Case 11: Result = "Onze"
Case 12: Result = "Douze"
Case 13: Result = "Treize"
Case 14: Result = "Quatorze"
Case 15: Result = "Quinze"
Case 16: Result = "Seize"
Case 17: Result = "Dix-sept"
Case 18: Result = "Dix-huit"
Case 19: Result = "Diz-neuf"
Case 70: Result = "Soixante et Dix"
Case 71: Result = "Soixante et Onze"
Case 72: Result = "Soixante Douze"
Case 73: Result = "Soixante Treize"
Case 74: Result = "Soixante Quatorze"
Case 75: Result = "Soixante Quinze"
Case 76: Result = "Soixante Seize"
Case 77: Result = "Soixante Dix-Sept"
Case 78: Result = "Soixante Dix-huit"
Case 79: Result = "Soixante Dix-neuf"
Case 90: Result = "Quatre-Vingts Dix"
Case 91: Result = "Quatre-Vingts Onze"
Case 92: Result = "Quatre-Vingts Douze"
Case 93: Result = "Quatre-Vingts Treize"
Case 94: Result = "Quatre-Vingts Quatorze"
Case 95: Result = "Quatre-Vingts Quinze"
Case 96: Result = "Quatre-Vingts Seize"
Case 97: Result = "Quatre-Vingts Dix-sept"
Case 98: Result = "Quatre-Vingts Dix-huit"
Case 99: Result = "Quatre-Vingts Dix-neuf"
Case Else
End Select
Else ' If value between 20-69...
Select Case Val(Left(TensText, 1))
Case 2: Result = "Vingts "
Case 3: Result = "Trente "
Case 4: Result = "Quarante "
Case 5: Result = "Cinquante "
Case 6: Result = "Soixante "
Case 8: Result = "Quatre-vingts "
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.
End If
GetTens = Result
End Function
' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "Un"
Case 2: GetDigit = "Deux "
Case 3: GetDigit = "Trois "
Case 4: GetDigit = "Quattre "
Case 5: GetDigit = "Cinq "
Case 6: GetDigit = "Six "
Case 7: GetDigit = "Sept "
Case 8: GetDigit = "Huit "
Case 9: GetDigit = "Neuf "
Case Else: GetDigit = ""
End Select
End FunctionBonjour et bienvenue,
J'utilise cette fonction.
Je ne suis pas à l'origine de ce code et je suis incapable de dire où je l'ai récupéré.
Essaie le
Function chiffrelettre(s)
Dim a As Variant, gros As Variant
a = Array("", "un", "deux", "trois", "quatre", "cinq", "six", "sept", _
"huit", "neuf", "dix", "onze", "douze", "treize", "quatorze", "quinze", "seize", "dix sept", _
"dix huit", "dix neuf", "vingt", "vingt et un", "vingt deux", "vingt trois", "vingt quatre", _
"vingt cinq", "vingt six", "vingt sept", "vingt huit", "vingt neuf", "trente", "trente et un", _
"trente deux", "trente trois", "trente quatre", "trente cinq", "trente six", "trente sept", _
"trente huit", "trente neuf", "quarante", "quarante et un", "quarante deux", "quarante trois", _
"quarante quatre", "quarante cinq", "quarante six", "quarante sept", "quarante huit", _
"quarante neuf", "cinquante", "cinquante et un", "cinquante deux", "cinquante trois", _
"cinquante quatre", "cinquante cinq", "cinquante six", "cinquante sept", "cinquante huit", _
"cinquante neuf", "soixante", "soixante et un", "soixante deux", "soixante trois", _
"soixante quatre", "soixante cinq", "soixante six", "soixante sept", "soixante huit", _
"soixante neuf", "soixante dix", "soixante et onze", "soixante douze", "soixante treize", _
"soixante quatorze", "soixante quinze", "soixante seize", "soixante dix sept", _
"soixante dix huit", "soixante dix neuf", "quatre-vingts", "quatre-vingt un", _
"quatre-vingt deux", "quatre-vingt trois", "quatre-vingt quatre", "quatre-vingt cinq", _
"quatre-vingt six", "quatre-vingt sept", "quatre-vingt huit", "quatre-vingt neuf", _
"quatre-vingt dix", "quatre-vingt onze", "quatre-vingt douze", "quatre-vingt treize", _
"quatre-vingt quatorze", "quatre-vingt quinze", "quatre-vingt seize", "quatre-vingt dix sept", _
"quatre-vingt dix huit", "quatre-vingt dix neuf")
gros = Array("", "billions", "milliards", "millions", "mille", "Euros", "billion", _
"milliard", "million", "mille", "Euro")
sp = Space(1)
chaine = "00000000000000"
centime = s * 100 - (Int(s) * 100)
s = Str(Int(s)): lg = Len(s) - 1: s = Right(s, lg): lg = Len(s)
If lg < 15 Then chaine = Mid(chaine, 1, (15 - lg)) Else chaine = ""
s = chaine + s
'billions au centaines
gp = 1
For k = 1 To 5
x = Mid(s, gp, 1): c = a(Val(x))
x = Mid(s, gp + 1, 2): d = a(Val(x))
If k = 5 Then
If t2 <> "" And c & d = "" Then mydz = "Euros" & sp: GoTo fin
If t <> "" And c = "" And d = "un" Then mydz = "un Euros" & sp: GoTo fin
If t <> "" And t2 = "" And c & d = "" Then mydz = "d'Euros" & sp: GoTo fin
If t & c & d = "" Then myct = "": mydz = "": GoTo fin
End If
If c & d = "" Then GoTo fin
If d = "" And c <> "" And c <> "un" Then mydz = c & sp & "cents " & gros(k) & sp: GoTo fin
If d = "" And c = "un" Then mydz = "cent " & gros(k) & sp: GoTo fin
If d = "un" And c = "" Then myct = IIf(k = 4, gros(k) & sp, "un " & gros(k + 5) & sp): GoTo fin
If d <> "" And c = "un" Then mydz = "cent" & sp
If d <> "" And c <> "" And c <> "un" Then mydz = c & sp & "cent" + sp
myct = d & sp & gros(k) & sp
fin:
t2 = mydz & myct
t = t & mydz & myct
mydz = "": myct = ""
gp = gp + 3
Next
d = a(centime)
If t <> "" Then myct = IIf(centime = 1, " centime", " centimes")
If t = "" Then myct = IIf(centime = 1, " centime d'Euro", " centimes d'Euro")
If centime = 0 Then d = "": myct = ""
chiffrelettre = t & d & myct
End FunctionDans la cellule appelant la fonction:
chiffrelettre($N$54) $N$54 étant la cellule où la somme apparait.
Cordialement
M
C'est pas la réponse que je penssait avoir ... Mais je les essayer et il semblerais y avoir moin de bug que dans mon code . Donc je te le prend .
MERCI !