Conversion chiffre en lettre
aakpa
Messages postés
57
Date d'inscription
mardi 24 mai 2005
Statut
Membre
Dernière intervention
10 janvier 2016
-
15 juil. 2008 à 12:42
gillardg Messages postés 3275 Date d'inscription jeudi 3 avril 2008 Statut Membre Dernière intervention 14 septembre 2014 - 2 août 2008 à 09:15
gillardg Messages postés 3275 Date d'inscription jeudi 3 avril 2008 Statut Membre Dernière intervention 14 septembre 2014 - 2 août 2008 à 09:15
4 réponses
gillardg
Messages postés
3275
Date d'inscription
jeudi 3 avril 2008
Statut
Membre
Dernière intervention
14 septembre 2014
2
15 juil. 2008 à 12:51
15 juil. 2008 à 12:51
Public Function NumberToTextDutch(sValue As String) As String
' #VBIDEUtils#************************************************************
' * Author : Waty Thierry
' * Web Site : http://www.vbdiamond.com
' * E-Mail : [mailto:waty.thierry@vbdiamond.com waty.thierry@vbdiamond.com]
' * Date : 08/08/2005
' * Time : 18:14
' * Module Name : Lib_Module
' * Module Filename : Lib.bas
' * Procedure Name : NumberToTextDutch
' * Purpose :
' * Parameters :
' * sValue As String
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
' #VBIDEUtilsERROR#
On Error GoTo ERROR_NumberToTextDutch
Static Ones(0 To 9) As String
Static Teens(0 To 9) As String
Static Tens(0 To 9) As String
Static Thousands(0 To 4) As String
Dim i As Integer
Dim nPosition As Integer
Dim ValNb As Integer
Dim LesZeros As Integer
Dim sResult As String
Dim sTemp As String
Dim tmpBuff As String
Dim strEn As String ' contains the value "en"
Dim iParts As Integer ' number of portions of three digits in sValue
Dim sParts(10) As String ' contains 3 digits, sParts(1) are the last three
Dim j As Integer ' for next to loop thru sParts
Dim sNLresult As String ' result for NL text
strEn = "en"
iParts = 1 ' must be one to maintain french when Langue <> "NL"
sValue = Replace(sValue, " ", "")
' *** Splitting sValue in portions of 3 digits (or less for the last one)
Do While True
If Len(sValue) > 3 Then
sParts(iParts) = right(sValue, 3)
iParts = iParts + 1
sValue = Mid(sValue, 1, Len(sValue) - 3)
Else
sParts(iParts) = sValue
Exit Do
End If
Loop
Ones(0) = "nul"
Ones(1) = "een"
Ones(2) = "twee"
Ones(3) = "drie"
Ones(4) = "vier"
Ones(5) = "vijf"
Ones(6) = "zes"
Ones(7) = "zeven"
Ones(8) = "acht"
Ones(9) = "negen"
Teens(0) = "tien"
Teens(1) = "elf"
Teens(2) = "twaalf"
Teens(3) = "dertien"
Teens(4) = "veertien"
Teens(5) = "vijftien"
Teens(6) = "zestien"
Teens(7) = "zeventien"
Teens(8) = "achtien"
Teens(9) = "negentien"
Tens(0) = vbNullString
Tens(1) = "tien"
Tens(2) = "twintig"
Tens(3) = "dertig"
Tens(4) = "veertig"
Tens(5) = "vijftig"
Tens(6) = "zestig"
Tens(7) = "zeventig"
Tens(8) = "tachtig"
Tens(9) = "negentig"
Thousands(0) = vbNullString
Thousands(1) = "duizend"
Thousands(2) = "miljoen"
Thousands(3) = "miljard"
Thousands(4) = "duizend" ' starting the loop thru sParts, if iparts 1 then sValue sPart(1)
For j = 1 To iParts
If iParts = 1 Then
sTemp = CStr(Int(sValue))
Else
sTemp = CStr(Int(sParts(j)))
End If
For i = Len(sTemp) To 1 Step -1
ValNb = Val(Mid$(sTemp, i, 1))
nPosition = (Len(sTemp) - i) + 1
Select Case (nPosition Mod 3)
Case 1
LesZeros = False
If i = 1 Then
If ValNb > 0 Then ' original -> If ValNb > 1 Then what i Changend for one digit numbers
tmpBuff = Ones(ValNb) & " "
Else
tmpBuff = vbNullString
End If
ElseIf Mid$(sTemp, i - 1, 1) = "1" Then
tmpBuff = Teens(ValNb) & " "
i = i - 1
ElseIf Mid$(sTemp, i - 1, 1) = "9" Then
If Mid(sTemp, i, 1) <> 0 Then
tmpBuff = Ones(ValNb) & strEn & Tens(9) ' 91 to 99
Else
tmpBuff = Tens(9) ' 90
End If
i = i - 1
ElseIf Mid$(sTemp, i - 1, 1) = "7" Then
If Mid(sTemp, i, 1) <> 0 Then
tmpBuff = Ones(ValNb) & strEn & Tens(7) '71 - 79
Else
tmpBuff = Tens(7) ' 70
End If
i = i - 1
ElseIf ValNb > 0 Then
tmpBuff = Ones(ValNb) & " "
Else
LesZeros = True
If i > 1 Then
If Mid$(sTemp, i - 1, 1) <> "0" Then
LesZeros = False
End If
End If
If i > 2 Then
If Mid$(sTemp, i - 2, 1) <> "0" Then
LesZeros = False
End If
End If
tmpBuff = vbNullString
End If
If LesZeros = False And nPosition > 1 Then
tmpBuff = tmpBuff & Thousands(nPosition / 3) & " "
End If
sResult = tmpBuff & sResult
Case 2
If ValNb > 0 Then
If Len(sResult) = 0 Then
sResult = Tens(ValNb)
Else
sResult = Trim(sResult) & strEn & Tens(ValNb)
End If
End If
Case 0
If ValNb > 0 Then
If ValNb > 1 Then
sResult = Ones(ValNb) & "honderd" & sResult
Else
sResult = "honderd" & sResult
End If
End If
End Select
Next i
' added for NL , to add the 1000, milj etc in front of
' the result
If iParts > 1 And iParts <> j Then
If j < iParts Then
If sParts(j + 1) = "000" Then ' no adding of 1000, million etc
sNLresult = sResult & sNLresult
Else
sNLresult = Thousands(j) & sResult & sNLresult
End If
sResult = "" ' emptying the sresult for NL
End If
Else
sResult = sResult & sNLresult
End If
Next j
If Len(sResult) > 0 Then
sResult = UCase$(left$(sResult, 1)) & Mid$(sResult, 2)
ElseIf sTemp = "0" Then
sResult = Ones(0)
End If
EXIT_NumberToTextDutch:
NumberToTextDutch = Trim$(sResult)
Exit Function
' #VBIDEUtilsERROR#
ERROR_NumberToTextDutch:
sResult = vbNullString
Resume EXIT_NumberToTextDutch
End Function
Public Function NumberToTextEnglish(sValue As String) As String
' #VBIDEUtils#************************************************************
' * Author : Waty Thierry
' * Web Site : http://www.vbdiamond.com
' * E-Mail : [mailto:waty.thierry@vbdiamond.com waty.thierry@vbdiamond.com]
' * Date : 08/08/2005
' * Time : 14:49
' * Module Name : Lib_Module
' * Module Filename : Lib.bas
' * Procedure Name : NumberToTextEnglish
' * Purpose :
' * Parameters :
' * sValue As String
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
' #VBIDEUtilsERROR#
On Error GoTo ERROR_NumberToTextEnglish
Static Ones(0 To 9) As String
Static Teens(0 To 9) As String
Static Tens(0 To 9) As String
Static Thousands(0 To 4) As String
Static bInit As Boolean
Dim i As Integer
Dim bAllZeros As Boolean
Dim bShowThousands As Boolean
Dim sResult As String
Dim sBuff As String
Dim sTemp As String
Dim nCol As Integer
Dim nChar As Integer
' *** Only handles positive values
Debug.Assert sValue >= 0
If bInit = False Then
' *** Initialize array
bInit = True
Ones(0) = "zero"
Ones(1) = "one"
Ones(2) = "two"
Ones(3) = "three"
Ones(4) = "four"
Ones(5) = "five"
Ones(6) = "six"
Ones(7) = "seven"
Ones(8) = "eight"
Ones(9) = "nine"
Teens(0) = "ten"
Teens(1) = "eleven"
Teens(2) = "twelve"
Teens(3) = "thirteen"
Teens(4) = "fourteen"
Teens(5) = "fifteen"
Teens(6) = "sixteen"
Teens(7) = "seventeen"
Teens(8) = "eighteen"
Teens(9) = "nineteen"
Tens(0) = ""
Tens(1) = "ten"
Tens(2) = "twenty"
Tens(3) = "thirty"
Tens(4) = "forty"
Tens(5) = "fifty"
Tens(6) = "sixty"
Tens(7) = "seventy"
Tens(8) = "eighty"
Tens(9) = "ninety"
Thousands(0) = ""
Thousands(1) = "thousand" 'US numbering
Thousands(2) = "million"
Thousands(3) = "billion"
Thousands(4) = "trillion"
End If
' *** Get fractional part
sBuff = vbNullString '"and " & Format((sValue - Int(sValue)) * 100, "00") & "/100"
' *** Convert rest to string and process each digit
sResult = CStr(Int(sValue))
' *** Non-zero digit not yet encountered
bAllZeros = True
' *** Iterate through string
For i = Len(sResult) To 1 Step -1
'*** Get value of this digit
nChar = Val(Mid$(sResult, i, 1))
' *** Get column position
nCol = (Len(sResult) - i) + 1
' *** Action depends on 1's, 10's or 100's column
Select Case (nCol Mod 3)
Case 1 '1's position
bShowThousands = True
If i = 1 Then
' *** First digit in number (last in loop)
sTemp = Ones(nChar) & " "
ElseIf Mid$(sResult, i - 1, 1) = "1" Then
' *** This digit is part of "teen" number
sTemp = Teens(nChar) & " "
i = i - 1 'Skip tens position
ElseIf nChar > 0 Then
' *** Any non-zero digit
sTemp = Ones(nChar) & " "
Else
' *** This digit is zero. If digit in tens and hundreds column are also zero, don't show "thousands"
bShowThousands = False
' *** Test for non-zero digit in this grouping
If Mid$(sResult, i - 1, 1) <> "0" Then
bShowThousands = True
ElseIf i > 2 Then
If Mid$(sResult, i - 2, 1) <> "0" Then
bShowThousands = True
End If
End If
sTemp = ""
End If
' *** Show "thousands" if non-zero in grouping
If bShowThousands Then
If nCol > 1 Then
sTemp = sTemp & Thousands(nCol \ 3)
If bAllZeros Then
sTemp = sTemp & " "
Else
sTemp = sTemp & ", "
End If
End If
' *** Indicate non-zero digit encountered
bAllZeros = False
End If
sBuff = sTemp & sBuff
Case 2 '10's position
If nChar > 0 Then
If Mid$(sResult, i + 1, 1) <> "0" Then
sBuff = Tens(nChar) & "-" & sBuff
Else
sBuff = Tens(nChar) & " " & sBuff
End If
End If
Case 0 '100's position
If nChar > 0 Then
sBuff = Ones(nChar) & " hundred " & sBuff
End If
End Select
Next i
' *** Convert first letter to upper case
sBuff = UCase$(left$(sBuff, 1)) & Mid$(sBuff, 2)
EXIT_NumberToTextEnglish:
' *** Return result
NumberToTextEnglish = sBuff
Exit Function
' #VBIDEUtilsERROR#
ERROR_NumberToTextEnglish:
Resume EXIT_NumberToTextEnglish
End Function
Public Function NumberToTextFrench(sValue As String, Optional nPays As Integer = 0) As String
' #VBIDEUtils#************************************************************
' * Author : Waty Thierry
' * Web Site : http://www.vbdiamond.com
' * E-Mail : [mailto:waty.thierry@vbdiamond.com waty.thierry@vbdiamond.com]
' * Date : 02/26/2003
' * Project Name : ImmoAssist
' * Module Name : Lib_Module
' * Module Filename : Lib.bas
' * Procedure Name : NumberToTextFrench
' * Purpose :
' * Parameters :
' * sValue As String
' * Optional nPays As Integer = 0
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * Screenshot :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
' #VBIDEUtilsERROR#
On Error GoTo ERROR_NumberToTextFrench
Static Ones(0 To 9) As String
Static Teens(0 To 9) As String
Static Tens(0 To 9) As String
Static Thousands(0 To 5) As String
Dim i As Integer
Dim nPosition As Integer
Dim ValNb As Integer
Dim LesZeros As Integer
Dim sResult As String
Dim sTemp As String
Dim tmpBuff As String
Ones(0) = "zéro"
Ones(1) = "un"
Ones(2) = "deux"
Ones(3) = "trois"
Ones(4) = "quatre"
Ones(5) = "cinq"
Ones(6) = "six"
Ones(7) = "sept"
Ones(8) = "huit"
Ones(9) = "neuf"
Teens(0) = "dix"
Teens(1) = "onze"
Teens(2) = "douze"
Teens(3) = "treize"
Teens(4) = "quatorze"
Teens(5) = "quinze"
Teens(6) = "seize"
Teens(7) = "dix-sept"
Teens(8) = "dix-huit"
Teens(9) = "dix-neuf"
Tens(0) = vbNullString
Tens(1) = "dix"
Tens(2) = "vingt"
Tens(3) = "trente"
Tens(4) = "quarante"
Tens(5) = "cinquante"
Tens(6) = "soixante"
Select Case nPays
Case 0
' *** France
Tens(7) = "soixante-dix"
Tens(8) = "quatre-vingt"
Tens(9) = "quatre-vingt-dix"
Case 1
' *** Belgium
Tens(7) = "septante"
Tens(8) = "quatre-vingt"
Tens(9) = "nonante"
Case 2
' *** Suisse
Tens(7) = "septante"
Tens(8) = "octante"
Tens(9) = "nonante"
End Select
Thousands(0) = vbNullString
Thousands(1) = "mille"
Thousands(2) = "million"
Thousands(3) = "millard"
Thousands(4) = "billion"
sTemp = CStr(Int(sValue))
For i = Len(sTemp) To 1 Step -1
ValNb = Val(Mid$(sTemp, i, 1))
nPosition = (Len(sTemp) - i) + 1
Select Case (nPosition Mod 3)
Case 1
LesZeros = False
If i = 1 Then
If ValNb > 1 Then
tmpBuff = Ones(ValNb) & " "
Else
tmpBuff = vbNullString
End If
ElseIf Mid$(sTemp, i - 1, 1) = "1" Then
tmpBuff = Teens(ValNb) & " "
i = i - 1
ElseIf Mid$(sTemp, i - 1, 1) = "9" Then
If nPays = 0 Then
tmpBuff = Tens(8) & " " & Teens(ValNb) & " "
Else
tmpBuff = Tens(9) & " " If ValNb > 0 Then tmpBuff tmpBuff & IIf(ValNb 1, "et ", "") & Ones(ValNb) & " "
End If
i = i - 1
ElseIf Mid$(sTemp, i - 1, 1) = "7" Then
If nPays = 0 Then
tmpBuff = Tens(6) & " " & Teens(ValNb) & " "
Else
tmpBuff = Tens(7) & " " If ValNb > 0 Then tmpBuff tmpBuff & IIf(ValNb 1, "et ", "") & Ones(ValNb) & " "
End If
i = i - 1
ElseIf ValNb > 0 Then
tmpBuff = Ones(ValNb) & " "
Else
LesZeros = True
If i > 1 Then
If Mid$(sTemp, i - 1, 1) <> "0" Then
LesZeros = False
End If
End If
If i > 2 Then
If Mid$(sTemp, i - 2, 1) <> "0" Then
LesZeros = False
End If
End If
tmpBuff = vbNullString
End If
If LesZeros = False And nPosition > 1 Then
tmpBuff = tmpBuff & Thousands(nPosition / 3) & " "
End If
sResult = tmpBuff & sResult
Case 2
If ValNb > 0 Then
sResult = Tens(ValNb) & " " & sResult
End If
Case 0
If ValNb > 0 Then
If ValNb > 1 Then
sResult = Ones(ValNb) & " cent " & sResult
Else
sResult = "cent " & sResult
End If
End If
End Select
Next i
If Len(sResult) > 0 Then
sResult = UCase$(left$(sResult, 1)) & Mid$(sResult, 2)
ElseIf sTemp = "0" Then
sResult = Ones(0)
End If
NumberToTextFrench = Trim$(sResult)
EXIT_NumberToTextFrench:
Exit Function
' #VBIDEUtilsERROR#
ERROR_NumberToTextFrench:
sResult = vbNullString
Resume EXIT_NumberToTextFrench
End Function
Public Function NumberToTextSpanish(sValue As String) As String
' #VBIDEUtils#************************************************************
' * Author : Waty Thierry
' * Web Site : http://www.vbdiamond.com
' * E-Mail : [mailto:waty.thierry@vbdiamond.com waty.thierry@vbdiamond.com]
' * Date : 08/08/2005
' * Time : 18:13
' * Module Name : Lib_Module
' * Module Filename : Lib.bas
' * Procedure Name : NumberToTextSpanish
' * Purpose :
' * Parameters :
' * sValue As String
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
' #VBIDEUtilsERROR#
On Error GoTo ERROR_NumberToTextSpanish
Static Ones(0 To 9) As String
Static Teens(0 To 9) As String
Static Tens(0 To 9) As String
Static Thousands(0 To 5) As String
Static dup_Thousands(0 To 5) As String
Dim i As Integer
Dim nPosition As Integer
Dim ValNb As Integer
Dim LesZeros As Integer
Dim sResult As String
Dim sTemp As String
Dim tmpBuff As String
Dim bAllZeros As Boolean
Dim bShow1000 As Boolean
Dim bNintyNines As Boolean
Dim sReturn As String
Dim sBuff As String
Dim nCol As Long
Dim nChar As Long
bNintyNines = True
bAllZeros = False
bShow1000 = False
Ones(0) = "cero"
Ones(1) = "uno"
Ones(2) = "dos"
Ones(3) = "tres"
Ones(4) = "cuatro"
Ones(5) = "cinco"
Ones(6) = "seis"
Ones(7) = "siete"
Ones(8) = "ocho"
Ones(9) = "nueve"
Teens(0) = "diez"
Teens(1) = "once"
Teens(2) = "doce"
Teens(3) = "trece"
Teens(4) = "catorce"
Teens(5) = "quince"
Teens(6) = "dieciseis"
Teens(7) = "diecisiete"
Teens(8) = "dieciocho"
Teens(9) = "diecinueve"
Tens(0) = vbNullString
Tens(1) = "diez"
Tens(2) = "veinte"
Tens(3) = "treinta"
Tens(4) = "cuarenta"
Tens(5) = "cincuenta"
Tens(6) = "sesenta"
Tens(7) = "setenta"
Tens(8) = "ochenta"
Tens(9) = "noventa"
Thousands(0) = vbNullString
Thousands(1) = "mil"
Thousands(2) = "million"
Thousands(3) = "mil million"
Thousands(4) = "billion"
Thousands(5) = "trillion"
dup_Thousands(0) = vbNullString
dup_Thousands(1) = "mil"
dup_Thousands(2) = "milliones"
dup_Thousands(3) = "mil milliones"
dup_Thousands(4) = "billiones"
dup_Thousands(5) = "trilliones"
sValue = Replace(sValue, " ", "")
If IsNumeric(sValue) = False Then Exit Function
sReturn = sValue
bAllZeros = True
For i = Len(sReturn) To 1 Step -1
nChar = CInt(Mid(sReturn, i, 1))
nCol = (Len(sReturn) - i) + 1
Select Case (nCol Mod 3)
Case 1 '1'
bShow1000 = True
If i = 1 Then
If nChar = 1 Then
Select Case nCol
Case 1 sTemp IIf(nCol 1, "uno ", "un ")
Case 4
sTemp = ""
Case Else
sTemp = "Un "
End Select
Else
sTemp = Ones(nChar) & " "
End If
If nChar > 1 Then
bNintyNines = True
End If
ElseIf Mid(sReturn, i - 1, 1) = "1" Then
sTemp = Teens(nChar) & " "
i = i - 1 'Skip
bNintyNines = True
ElseIf nChar > 0 Then sTemp IIf(nChar 1, IIf(nCol = 1, "Uno ", "Un "), Ones(nChar) & " ")
bNintyNines = True
Else
bShow1000 = False
If Mid(sReturn, i - 1, 1) <> "0" Then
bShow1000 = True
ElseIf i > 2 Then
If Mid(sReturn, i - 2, 1) <> "0" Then
bShow1000 = True
End If
End If
sTemp = ""
bNintyNines = False
End If
If bShow1000 Then
If nCol > 1 Then
If nCol \ 3 > 5 Then
sTemp = sTemp & IIf(nChar > 1, dup_Thousands(5), Thousands(5))
Else
sTemp = sTemp & IIf(nChar > 1, dup_Thousands(nCol \ 3), Thousands(nCol \ 3))
End If
If bAllZeros Then sTemp = sTemp & " "
End If
bAllZeros = False
End If
sBuff = sTemp & sBuff
Case 2 '10'
If nChar > 0 Then
If Mid(sReturn, i + 1, 1) <> "0" Then
sBuff = Tens(nChar) & " y " & sBuff
Else
sBuff = Tens(nChar) & " " & sBuff
End If
If Not bNintyNines Then
bNintyNines = True
End If
End If
Case 0 '100'
If nChar > 0 Then
If nChar = 1 Then
If bNintyNines Then
sBuff = " ciento " & sBuff
bNintyNines = False
Else
sBuff = " cien " & sBuff
bNintyNines = False
End If
Else
If nChar = 5 Then
sBuff = "quinientos " & sBuff
Else
sBuff = Ones(nChar) & "cientos " & sBuff
End If
End If
End If
End Select
Next
sBuff = Trim$(sBuff)
sBuff = UCase(left$(sBuff, 1)) & Mid(sBuff, 2)
EXIT_NumberToTextSpanish:
NumberToTextSpanish = sBuff
Exit Function
' #VBIDEUtilsERROR#
ERROR_NumberToTextSpanish:
sBuff = vbNullString
Resume EXIT_NumberToTextSpanish
End Function
' #VBIDEUtils#************************************************************
' * Author : Waty Thierry
' * Web Site : http://www.vbdiamond.com
' * E-Mail : [mailto:waty.thierry@vbdiamond.com waty.thierry@vbdiamond.com]
' * Date : 08/08/2005
' * Time : 18:14
' * Module Name : Lib_Module
' * Module Filename : Lib.bas
' * Procedure Name : NumberToTextDutch
' * Purpose :
' * Parameters :
' * sValue As String
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
' #VBIDEUtilsERROR#
On Error GoTo ERROR_NumberToTextDutch
Static Ones(0 To 9) As String
Static Teens(0 To 9) As String
Static Tens(0 To 9) As String
Static Thousands(0 To 4) As String
Dim i As Integer
Dim nPosition As Integer
Dim ValNb As Integer
Dim LesZeros As Integer
Dim sResult As String
Dim sTemp As String
Dim tmpBuff As String
Dim strEn As String ' contains the value "en"
Dim iParts As Integer ' number of portions of three digits in sValue
Dim sParts(10) As String ' contains 3 digits, sParts(1) are the last three
Dim j As Integer ' for next to loop thru sParts
Dim sNLresult As String ' result for NL text
strEn = "en"
iParts = 1 ' must be one to maintain french when Langue <> "NL"
sValue = Replace(sValue, " ", "")
' *** Splitting sValue in portions of 3 digits (or less for the last one)
Do While True
If Len(sValue) > 3 Then
sParts(iParts) = right(sValue, 3)
iParts = iParts + 1
sValue = Mid(sValue, 1, Len(sValue) - 3)
Else
sParts(iParts) = sValue
Exit Do
End If
Loop
Ones(0) = "nul"
Ones(1) = "een"
Ones(2) = "twee"
Ones(3) = "drie"
Ones(4) = "vier"
Ones(5) = "vijf"
Ones(6) = "zes"
Ones(7) = "zeven"
Ones(8) = "acht"
Ones(9) = "negen"
Teens(0) = "tien"
Teens(1) = "elf"
Teens(2) = "twaalf"
Teens(3) = "dertien"
Teens(4) = "veertien"
Teens(5) = "vijftien"
Teens(6) = "zestien"
Teens(7) = "zeventien"
Teens(8) = "achtien"
Teens(9) = "negentien"
Tens(0) = vbNullString
Tens(1) = "tien"
Tens(2) = "twintig"
Tens(3) = "dertig"
Tens(4) = "veertig"
Tens(5) = "vijftig"
Tens(6) = "zestig"
Tens(7) = "zeventig"
Tens(8) = "tachtig"
Tens(9) = "negentig"
Thousands(0) = vbNullString
Thousands(1) = "duizend"
Thousands(2) = "miljoen"
Thousands(3) = "miljard"
Thousands(4) = "duizend" ' starting the loop thru sParts, if iparts 1 then sValue sPart(1)
For j = 1 To iParts
If iParts = 1 Then
sTemp = CStr(Int(sValue))
Else
sTemp = CStr(Int(sParts(j)))
End If
For i = Len(sTemp) To 1 Step -1
ValNb = Val(Mid$(sTemp, i, 1))
nPosition = (Len(sTemp) - i) + 1
Select Case (nPosition Mod 3)
Case 1
LesZeros = False
If i = 1 Then
If ValNb > 0 Then ' original -> If ValNb > 1 Then what i Changend for one digit numbers
tmpBuff = Ones(ValNb) & " "
Else
tmpBuff = vbNullString
End If
ElseIf Mid$(sTemp, i - 1, 1) = "1" Then
tmpBuff = Teens(ValNb) & " "
i = i - 1
ElseIf Mid$(sTemp, i - 1, 1) = "9" Then
If Mid(sTemp, i, 1) <> 0 Then
tmpBuff = Ones(ValNb) & strEn & Tens(9) ' 91 to 99
Else
tmpBuff = Tens(9) ' 90
End If
i = i - 1
ElseIf Mid$(sTemp, i - 1, 1) = "7" Then
If Mid(sTemp, i, 1) <> 0 Then
tmpBuff = Ones(ValNb) & strEn & Tens(7) '71 - 79
Else
tmpBuff = Tens(7) ' 70
End If
i = i - 1
ElseIf ValNb > 0 Then
tmpBuff = Ones(ValNb) & " "
Else
LesZeros = True
If i > 1 Then
If Mid$(sTemp, i - 1, 1) <> "0" Then
LesZeros = False
End If
End If
If i > 2 Then
If Mid$(sTemp, i - 2, 1) <> "0" Then
LesZeros = False
End If
End If
tmpBuff = vbNullString
End If
If LesZeros = False And nPosition > 1 Then
tmpBuff = tmpBuff & Thousands(nPosition / 3) & " "
End If
sResult = tmpBuff & sResult
Case 2
If ValNb > 0 Then
If Len(sResult) = 0 Then
sResult = Tens(ValNb)
Else
sResult = Trim(sResult) & strEn & Tens(ValNb)
End If
End If
Case 0
If ValNb > 0 Then
If ValNb > 1 Then
sResult = Ones(ValNb) & "honderd" & sResult
Else
sResult = "honderd" & sResult
End If
End If
End Select
Next i
' added for NL , to add the 1000, milj etc in front of
' the result
If iParts > 1 And iParts <> j Then
If j < iParts Then
If sParts(j + 1) = "000" Then ' no adding of 1000, million etc
sNLresult = sResult & sNLresult
Else
sNLresult = Thousands(j) & sResult & sNLresult
End If
sResult = "" ' emptying the sresult for NL
End If
Else
sResult = sResult & sNLresult
End If
Next j
If Len(sResult) > 0 Then
sResult = UCase$(left$(sResult, 1)) & Mid$(sResult, 2)
ElseIf sTemp = "0" Then
sResult = Ones(0)
End If
EXIT_NumberToTextDutch:
NumberToTextDutch = Trim$(sResult)
Exit Function
' #VBIDEUtilsERROR#
ERROR_NumberToTextDutch:
sResult = vbNullString
Resume EXIT_NumberToTextDutch
End Function
Public Function NumberToTextEnglish(sValue As String) As String
' #VBIDEUtils#************************************************************
' * Author : Waty Thierry
' * Web Site : http://www.vbdiamond.com
' * E-Mail : [mailto:waty.thierry@vbdiamond.com waty.thierry@vbdiamond.com]
' * Date : 08/08/2005
' * Time : 14:49
' * Module Name : Lib_Module
' * Module Filename : Lib.bas
' * Procedure Name : NumberToTextEnglish
' * Purpose :
' * Parameters :
' * sValue As String
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
' #VBIDEUtilsERROR#
On Error GoTo ERROR_NumberToTextEnglish
Static Ones(0 To 9) As String
Static Teens(0 To 9) As String
Static Tens(0 To 9) As String
Static Thousands(0 To 4) As String
Static bInit As Boolean
Dim i As Integer
Dim bAllZeros As Boolean
Dim bShowThousands As Boolean
Dim sResult As String
Dim sBuff As String
Dim sTemp As String
Dim nCol As Integer
Dim nChar As Integer
' *** Only handles positive values
Debug.Assert sValue >= 0
If bInit = False Then
' *** Initialize array
bInit = True
Ones(0) = "zero"
Ones(1) = "one"
Ones(2) = "two"
Ones(3) = "three"
Ones(4) = "four"
Ones(5) = "five"
Ones(6) = "six"
Ones(7) = "seven"
Ones(8) = "eight"
Ones(9) = "nine"
Teens(0) = "ten"
Teens(1) = "eleven"
Teens(2) = "twelve"
Teens(3) = "thirteen"
Teens(4) = "fourteen"
Teens(5) = "fifteen"
Teens(6) = "sixteen"
Teens(7) = "seventeen"
Teens(8) = "eighteen"
Teens(9) = "nineteen"
Tens(0) = ""
Tens(1) = "ten"
Tens(2) = "twenty"
Tens(3) = "thirty"
Tens(4) = "forty"
Tens(5) = "fifty"
Tens(6) = "sixty"
Tens(7) = "seventy"
Tens(8) = "eighty"
Tens(9) = "ninety"
Thousands(0) = ""
Thousands(1) = "thousand" 'US numbering
Thousands(2) = "million"
Thousands(3) = "billion"
Thousands(4) = "trillion"
End If
' *** Get fractional part
sBuff = vbNullString '"and " & Format((sValue - Int(sValue)) * 100, "00") & "/100"
' *** Convert rest to string and process each digit
sResult = CStr(Int(sValue))
' *** Non-zero digit not yet encountered
bAllZeros = True
' *** Iterate through string
For i = Len(sResult) To 1 Step -1
'*** Get value of this digit
nChar = Val(Mid$(sResult, i, 1))
' *** Get column position
nCol = (Len(sResult) - i) + 1
' *** Action depends on 1's, 10's or 100's column
Select Case (nCol Mod 3)
Case 1 '1's position
bShowThousands = True
If i = 1 Then
' *** First digit in number (last in loop)
sTemp = Ones(nChar) & " "
ElseIf Mid$(sResult, i - 1, 1) = "1" Then
' *** This digit is part of "teen" number
sTemp = Teens(nChar) & " "
i = i - 1 'Skip tens position
ElseIf nChar > 0 Then
' *** Any non-zero digit
sTemp = Ones(nChar) & " "
Else
' *** This digit is zero. If digit in tens and hundreds column are also zero, don't show "thousands"
bShowThousands = False
' *** Test for non-zero digit in this grouping
If Mid$(sResult, i - 1, 1) <> "0" Then
bShowThousands = True
ElseIf i > 2 Then
If Mid$(sResult, i - 2, 1) <> "0" Then
bShowThousands = True
End If
End If
sTemp = ""
End If
' *** Show "thousands" if non-zero in grouping
If bShowThousands Then
If nCol > 1 Then
sTemp = sTemp & Thousands(nCol \ 3)
If bAllZeros Then
sTemp = sTemp & " "
Else
sTemp = sTemp & ", "
End If
End If
' *** Indicate non-zero digit encountered
bAllZeros = False
End If
sBuff = sTemp & sBuff
Case 2 '10's position
If nChar > 0 Then
If Mid$(sResult, i + 1, 1) <> "0" Then
sBuff = Tens(nChar) & "-" & sBuff
Else
sBuff = Tens(nChar) & " " & sBuff
End If
End If
Case 0 '100's position
If nChar > 0 Then
sBuff = Ones(nChar) & " hundred " & sBuff
End If
End Select
Next i
' *** Convert first letter to upper case
sBuff = UCase$(left$(sBuff, 1)) & Mid$(sBuff, 2)
EXIT_NumberToTextEnglish:
' *** Return result
NumberToTextEnglish = sBuff
Exit Function
' #VBIDEUtilsERROR#
ERROR_NumberToTextEnglish:
Resume EXIT_NumberToTextEnglish
End Function
Public Function NumberToTextFrench(sValue As String, Optional nPays As Integer = 0) As String
' #VBIDEUtils#************************************************************
' * Author : Waty Thierry
' * Web Site : http://www.vbdiamond.com
' * E-Mail : [mailto:waty.thierry@vbdiamond.com waty.thierry@vbdiamond.com]
' * Date : 02/26/2003
' * Project Name : ImmoAssist
' * Module Name : Lib_Module
' * Module Filename : Lib.bas
' * Procedure Name : NumberToTextFrench
' * Purpose :
' * Parameters :
' * sValue As String
' * Optional nPays As Integer = 0
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * Screenshot :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
' #VBIDEUtilsERROR#
On Error GoTo ERROR_NumberToTextFrench
Static Ones(0 To 9) As String
Static Teens(0 To 9) As String
Static Tens(0 To 9) As String
Static Thousands(0 To 5) As String
Dim i As Integer
Dim nPosition As Integer
Dim ValNb As Integer
Dim LesZeros As Integer
Dim sResult As String
Dim sTemp As String
Dim tmpBuff As String
Ones(0) = "zéro"
Ones(1) = "un"
Ones(2) = "deux"
Ones(3) = "trois"
Ones(4) = "quatre"
Ones(5) = "cinq"
Ones(6) = "six"
Ones(7) = "sept"
Ones(8) = "huit"
Ones(9) = "neuf"
Teens(0) = "dix"
Teens(1) = "onze"
Teens(2) = "douze"
Teens(3) = "treize"
Teens(4) = "quatorze"
Teens(5) = "quinze"
Teens(6) = "seize"
Teens(7) = "dix-sept"
Teens(8) = "dix-huit"
Teens(9) = "dix-neuf"
Tens(0) = vbNullString
Tens(1) = "dix"
Tens(2) = "vingt"
Tens(3) = "trente"
Tens(4) = "quarante"
Tens(5) = "cinquante"
Tens(6) = "soixante"
Select Case nPays
Case 0
' *** France
Tens(7) = "soixante-dix"
Tens(8) = "quatre-vingt"
Tens(9) = "quatre-vingt-dix"
Case 1
' *** Belgium
Tens(7) = "septante"
Tens(8) = "quatre-vingt"
Tens(9) = "nonante"
Case 2
' *** Suisse
Tens(7) = "septante"
Tens(8) = "octante"
Tens(9) = "nonante"
End Select
Thousands(0) = vbNullString
Thousands(1) = "mille"
Thousands(2) = "million"
Thousands(3) = "millard"
Thousands(4) = "billion"
sTemp = CStr(Int(sValue))
For i = Len(sTemp) To 1 Step -1
ValNb = Val(Mid$(sTemp, i, 1))
nPosition = (Len(sTemp) - i) + 1
Select Case (nPosition Mod 3)
Case 1
LesZeros = False
If i = 1 Then
If ValNb > 1 Then
tmpBuff = Ones(ValNb) & " "
Else
tmpBuff = vbNullString
End If
ElseIf Mid$(sTemp, i - 1, 1) = "1" Then
tmpBuff = Teens(ValNb) & " "
i = i - 1
ElseIf Mid$(sTemp, i - 1, 1) = "9" Then
If nPays = 0 Then
tmpBuff = Tens(8) & " " & Teens(ValNb) & " "
Else
tmpBuff = Tens(9) & " " If ValNb > 0 Then tmpBuff tmpBuff & IIf(ValNb 1, "et ", "") & Ones(ValNb) & " "
End If
i = i - 1
ElseIf Mid$(sTemp, i - 1, 1) = "7" Then
If nPays = 0 Then
tmpBuff = Tens(6) & " " & Teens(ValNb) & " "
Else
tmpBuff = Tens(7) & " " If ValNb > 0 Then tmpBuff tmpBuff & IIf(ValNb 1, "et ", "") & Ones(ValNb) & " "
End If
i = i - 1
ElseIf ValNb > 0 Then
tmpBuff = Ones(ValNb) & " "
Else
LesZeros = True
If i > 1 Then
If Mid$(sTemp, i - 1, 1) <> "0" Then
LesZeros = False
End If
End If
If i > 2 Then
If Mid$(sTemp, i - 2, 1) <> "0" Then
LesZeros = False
End If
End If
tmpBuff = vbNullString
End If
If LesZeros = False And nPosition > 1 Then
tmpBuff = tmpBuff & Thousands(nPosition / 3) & " "
End If
sResult = tmpBuff & sResult
Case 2
If ValNb > 0 Then
sResult = Tens(ValNb) & " " & sResult
End If
Case 0
If ValNb > 0 Then
If ValNb > 1 Then
sResult = Ones(ValNb) & " cent " & sResult
Else
sResult = "cent " & sResult
End If
End If
End Select
Next i
If Len(sResult) > 0 Then
sResult = UCase$(left$(sResult, 1)) & Mid$(sResult, 2)
ElseIf sTemp = "0" Then
sResult = Ones(0)
End If
NumberToTextFrench = Trim$(sResult)
EXIT_NumberToTextFrench:
Exit Function
' #VBIDEUtilsERROR#
ERROR_NumberToTextFrench:
sResult = vbNullString
Resume EXIT_NumberToTextFrench
End Function
Public Function NumberToTextSpanish(sValue As String) As String
' #VBIDEUtils#************************************************************
' * Author : Waty Thierry
' * Web Site : http://www.vbdiamond.com
' * E-Mail : [mailto:waty.thierry@vbdiamond.com waty.thierry@vbdiamond.com]
' * Date : 08/08/2005
' * Time : 18:13
' * Module Name : Lib_Module
' * Module Filename : Lib.bas
' * Procedure Name : NumberToTextSpanish
' * Purpose :
' * Parameters :
' * sValue As String
' * Purpose :
' **********************************************************************
' * Comments :
' *
' *
' * Example :
' *
' * See Also :
' *
' * History :
' *
' *
' **********************************************************************
' #VBIDEUtilsERROR#
On Error GoTo ERROR_NumberToTextSpanish
Static Ones(0 To 9) As String
Static Teens(0 To 9) As String
Static Tens(0 To 9) As String
Static Thousands(0 To 5) As String
Static dup_Thousands(0 To 5) As String
Dim i As Integer
Dim nPosition As Integer
Dim ValNb As Integer
Dim LesZeros As Integer
Dim sResult As String
Dim sTemp As String
Dim tmpBuff As String
Dim bAllZeros As Boolean
Dim bShow1000 As Boolean
Dim bNintyNines As Boolean
Dim sReturn As String
Dim sBuff As String
Dim nCol As Long
Dim nChar As Long
bNintyNines = True
bAllZeros = False
bShow1000 = False
Ones(0) = "cero"
Ones(1) = "uno"
Ones(2) = "dos"
Ones(3) = "tres"
Ones(4) = "cuatro"
Ones(5) = "cinco"
Ones(6) = "seis"
Ones(7) = "siete"
Ones(8) = "ocho"
Ones(9) = "nueve"
Teens(0) = "diez"
Teens(1) = "once"
Teens(2) = "doce"
Teens(3) = "trece"
Teens(4) = "catorce"
Teens(5) = "quince"
Teens(6) = "dieciseis"
Teens(7) = "diecisiete"
Teens(8) = "dieciocho"
Teens(9) = "diecinueve"
Tens(0) = vbNullString
Tens(1) = "diez"
Tens(2) = "veinte"
Tens(3) = "treinta"
Tens(4) = "cuarenta"
Tens(5) = "cincuenta"
Tens(6) = "sesenta"
Tens(7) = "setenta"
Tens(8) = "ochenta"
Tens(9) = "noventa"
Thousands(0) = vbNullString
Thousands(1) = "mil"
Thousands(2) = "million"
Thousands(3) = "mil million"
Thousands(4) = "billion"
Thousands(5) = "trillion"
dup_Thousands(0) = vbNullString
dup_Thousands(1) = "mil"
dup_Thousands(2) = "milliones"
dup_Thousands(3) = "mil milliones"
dup_Thousands(4) = "billiones"
dup_Thousands(5) = "trilliones"
sValue = Replace(sValue, " ", "")
If IsNumeric(sValue) = False Then Exit Function
sReturn = sValue
bAllZeros = True
For i = Len(sReturn) To 1 Step -1
nChar = CInt(Mid(sReturn, i, 1))
nCol = (Len(sReturn) - i) + 1
Select Case (nCol Mod 3)
Case 1 '1'
bShow1000 = True
If i = 1 Then
If nChar = 1 Then
Select Case nCol
Case 1 sTemp IIf(nCol 1, "uno ", "un ")
Case 4
sTemp = ""
Case Else
sTemp = "Un "
End Select
Else
sTemp = Ones(nChar) & " "
End If
If nChar > 1 Then
bNintyNines = True
End If
ElseIf Mid(sReturn, i - 1, 1) = "1" Then
sTemp = Teens(nChar) & " "
i = i - 1 'Skip
bNintyNines = True
ElseIf nChar > 0 Then sTemp IIf(nChar 1, IIf(nCol = 1, "Uno ", "Un "), Ones(nChar) & " ")
bNintyNines = True
Else
bShow1000 = False
If Mid(sReturn, i - 1, 1) <> "0" Then
bShow1000 = True
ElseIf i > 2 Then
If Mid(sReturn, i - 2, 1) <> "0" Then
bShow1000 = True
End If
End If
sTemp = ""
bNintyNines = False
End If
If bShow1000 Then
If nCol > 1 Then
If nCol \ 3 > 5 Then
sTemp = sTemp & IIf(nChar > 1, dup_Thousands(5), Thousands(5))
Else
sTemp = sTemp & IIf(nChar > 1, dup_Thousands(nCol \ 3), Thousands(nCol \ 3))
End If
If bAllZeros Then sTemp = sTemp & " "
End If
bAllZeros = False
End If
sBuff = sTemp & sBuff
Case 2 '10'
If nChar > 0 Then
If Mid(sReturn, i + 1, 1) <> "0" Then
sBuff = Tens(nChar) & " y " & sBuff
Else
sBuff = Tens(nChar) & " " & sBuff
End If
If Not bNintyNines Then
bNintyNines = True
End If
End If
Case 0 '100'
If nChar > 0 Then
If nChar = 1 Then
If bNintyNines Then
sBuff = " ciento " & sBuff
bNintyNines = False
Else
sBuff = " cien " & sBuff
bNintyNines = False
End If
Else
If nChar = 5 Then
sBuff = "quinientos " & sBuff
Else
sBuff = Ones(nChar) & "cientos " & sBuff
End If
End If
End If
End Select
Next
sBuff = Trim$(sBuff)
sBuff = UCase(left$(sBuff, 1)) & Mid(sBuff, 2)
EXIT_NumberToTextSpanish:
NumberToTextSpanish = sBuff
Exit Function
' #VBIDEUtilsERROR#
ERROR_NumberToTextSpanish:
sBuff = vbNullString
Resume EXIT_NumberToTextSpanish
End Function
aakpa
Messages postés
57
Date d'inscription
mardi 24 mai 2005
Statut
Membre
Dernière intervention
10 janvier 2016
15 juil. 2008 à 13:38
15 juil. 2008 à 13:38
Merci ce code marche a la perfection.
Infiniment merci
Aidons nous
Infiniment merci
Aidons nous
cs_ghuysmans99
Messages postés
3982
Date d'inscription
jeudi 14 juillet 2005
Statut
Membre
Dernière intervention
30 juin 2013
16
1 août 2008 à 23:59
1 août 2008 à 23:59
Réponse acceptée
_________________________________________________________________________
VB.NETis good ...VB6is better<
_________________________________________________________________________
VB.NETis good ...VB6is better<
gillardg
Messages postés
3275
Date d'inscription
jeudi 3 avril 2008
Statut
Membre
Dernière intervention
14 septembre 2014
2
2 août 2008 à 09:15
2 août 2008 à 09:15
c'est vrai ça , ghuysmans99 as raison , il faut penser a cliquer sur le bouton réponse acceptée cela peut aider d'autres personnes
bonjour chez vous!
< body>
bonjour chez vous!
< body>
