XL 2016 Problème de conversion sur VBA Excel

Dada12345

XLDnaute Nouveau
Bonjour,

J’ai cette formule de VBA mais la conversion des microgrammes en milligrammes se fait à la place des centaines au lieu du millième : 0.524mg sera cinquante deux microgrammes.
Pourriez vous m’aidez s’il vous plaît?
Option Explicit

'Main Function

Function SpellNumber(ByVal MyNumber)

Dim milligrammes, microgrammes, Temp

Dim DecimalPlace, Count

ReDim Place(9) As String

Place(2) = " Mille "

Place(3) = " Million "

Place(4) = " Milliard "

Place(5) = " Trillion "

’ String representation of amount.

MyNumber = Trim(Str(MyNumber))

’ Position of decimal place 0 if none.

DecimalPlace = InStr(MyNumber, « . »)

’ Convert microgrammes and set MyNumber to dollar amount.

If DecimalPlace > 0 Then

microgrammes = 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 milligrammes = Temp & Place(Count) & milligrammes

If Len(MyNumber) > 3 Then

MyNumber = Left(MyNumber, Len(MyNumber) - 3)

Else

MyNumber = « »

End If

Count = Count + 1

Loop

Select Case milligrammes

Case « »

milligrammes = « 0 milligramme »

Case « Un »

milligrammes = « Un milligramme »

Case Else

milligrammes = milligrammes & " milligrammes"

End Select

Select Case microgrammes

Case « »

microgrammes = " et 0 microgramme"

Case « One »

microgrammes = " and un microgramme"

Case Else

microgrammes = " and " & microgrammes & " microgrammes"

End Select

SpellNumber = milligrammes & microgrammes

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.

If Mid(MyNumber, 1, 1) <> « 0 » Then

Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "

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.

If Val(Left(TensText, 1)) = 1 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 = « Dix-neuf »

Case Else

End Select

Else ’ If value between 20-99…

Select Case Val(Left(TensText, 1))

Case 2: Result = "Vingt "

Case 3: Result = "Trente "

Case 4: Result = "Quarante "

Case 5: Result = "Cinquante "

Case 6: Result = "Soixante "

Case 7: Result = "Soixante-Dix "

Case 8: Result = "Quatre-vingts "

Case 9: Result = "Quatre-vingt-dix "

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 = « Quatre »

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 Function
 

Discussions similaires