bakery1
asked on
Convert Currency Success
Thanks for dm_14
Your answer for my question has been successed, but it is reading from hundred only and all the invoice having 234.560 KD Fils but reading like this "KUWAITI DINAR 0 Two Hundred Thirty Four and fils 559 only. 1 fils price has reduced and if the invoice more than hundred I mean above thousand it will not read
Pls revert with complete amount read from
Example : Thousand 2348.598 (Kuwaiti Dinar two thousand three hundred forty eight and fils 598 only)
This is your formula :
United Arab Emirates
Here is the code for the conversion :
Example : NumToWord (23.343)
KUWAITI DINAR Twenty Three and FILS 343 only
'========================= ========== ========== ========== ====
' =====
' '*** This is the main function call
'========================= ========== ========== ========== ====
' =====
Function NumToWord(numval)
Dim NTW, NText, dollars, cents, NWord, totalcents As String
Dim decplace, TotalSets, cnt, LDollHold As Integer
ReDim NumParts(9) As String 'Array for Amount (sets of three)
ReDim Place(9) As String 'Array containing place holders
Dim LDoll As Integer 'Length of the Dollars Text Amount
Place(2) = " Thousand " '
Place(3) = " Million " 'Place holder names for money
Place(4) = " Billion " 'amounts
Place(5) = " Trillion " '
NTW = "" 'Temp value for the function
NText = round_curr(numval) 'Roundup the cents to eliminate cents gr 2
NText = Trim(Str(NText)) 'String representation of amount
decplace = InStr(Trim(NText), ".") 'Position of decimal 0 if none
dollars = Trim(Left(NText, IIf(decplace = 0, Len(numval), decplace - 1)))
LDoll = Len(dollars)
cents = Trim(Right(NText, IIf(decplace = 0, 0, Abs(decplace - Len(NText)))))
If Len(cents) = 1 Then
cents = cents & "0"
End If
If (LDoll Mod 3) = 0 Then
TotalSets = (LDoll \ 3)
Else
TotalSets = (LDoll \ 3) + 1
End If
cnt = 1
LDollHold = LDoll
Do While LDoll > 0
NumParts(cnt) = IIf(LDoll > 3, Right(dollars, 3), Trim(dollars))
dollars = IIf(LDoll > 3, Left(dollars, (IIf(LDoll < 3, 3, LDoll)) - 3), "")
LDoll = Len(dollars)
cnt = cnt + 1
Loop
For cnt = TotalSets To 1 Step -1 'step through NumParts array
NWord = GetWord(NumParts(cnt)) 'convert 1 element of NumParts
iP1 = InStr(cnt, ".")
NTW = NTW & NWord 'concatenate it to temp variable
If NWord <> "" Then NTW = NTW & Place(cnt)
Next cnt 'loop through
If LDollHold > 0 Then
NTW = "KUWAITI DINAR " & NTW & " and " 'concatenate text
Else
NTW = " NO KUWAITI DINAR " & NTW & " and " 'concatenate text
End If
If Len(cents) > 3 Then
cents = Left(cents, 3)
End If
totalcents = cents 'GetTens(cents) 'Convert cents part to word
If totalcents = "" Then totalfils = "NO" 'Concat NO if cents=0
NTW = NTW & "FILS " & totalcents & " only" 'Concat Dollars and Cents
NumToWord = NTW 'Assign word value to
End Function
'========================= ========== ========== ========== ===
' ======
' The following function converts a number from 1 to 9 to t
' ext
'========================= ========== ========== ========== ===
' ======
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "One" '
Case 2: GetDigit = "Two" '
Case 3: GetDigit = "Three" '
Case 4: GetDigit = "Four" ' Assign a numeric word value
Case 5: GetDigit = "Five" ' based on a single digit.
Case 6: GetDigit = "Six" '
Case 7: GetDigit = "Seven" '
Case 8: GetDigit = "Eight" '
Case 9: GetDigit = "Nine" '
Case Else: GetDigit = "" '
End Select
End Function 'End function GetDigit - return to calling program
'========================= ========== ========== ========== ===
' ======
' The following function converts a number from 10 to 99 to
' text
'========================= ========== ========== ========== ===
' ======
Function GetTens(tenstext)
Dim GT As String
GT = "" 'null out the temporary function value
If Val(Left(tenstext, 1)) = 1 Then ' If value between 10-19
Select Case Val(tenstext)
Case 10: GT = "Ten" '
Case 11: GT = "Eleven" '
Case 12: GT = "Twelve" '
Case 13: GT = "Thirteen" ' Retrieve numeric word
Case 14: GT = "Fourteen" ' value if between ten and
Case 15: GT = "Fifteen" ' nineteen inclusive.
Case 16: GT = "Sixteen" '
Case 17: GT = "Seventeen" '
Case 18: GT = "Eighteen" '
Case 19: GT = "Nineteen" '
Case Else
End Select
Else ' If value between 20-99
Select Case Val(Left(tenstext, 1))
Case 2: GT = "Twenty " '
Case 3: GT = "Thirty " '
Case 4: GT = "Forty " '
Case 5: GT = "Fifty " ' Retrieve value if it is
Case 6: GT = "Sixty " ' divisible by ten
Case 7: GT = "Seventy " ' excluding the value ten.
Case 8: GT = "Eighty " '
Case 9: GT = "Ninety " '
Case Else
End Select
GT = GT & GetDigit(Right(tenstext, 1)) 'Retrieve ones place
End If
GetTens = GT ' Assign function return value.
End Function
'========================= ========== ========== ========== ====
' ======
' The following function converts a number from 0 to 999 to
' text
'========================= ========== ========== ========== ====
' ======
Function GetWord(NumText)
Dim GW As String, x As Integer
GW = "" 'null out temporary function value
If Val(NumText) > 0 Then
For x = 1 To Len(NumText) 'loop the length of NumText times
Select Case Len(NumText)
Case 3:
If Val(NumText) > 99 Then
GW = GetDigit(Left(NumText, 1)) & " Hundred "
End If
NumText = Right(NumText, 2)
Case 2:
GW = GW & GetTens(NumText)
NumText = ""
Case 1:
GW = GetDigit(NumText)
Case Else
End Select
Next x
End If
GetWord = GW 'assign function return value
End Function 'End function GetWord - Return to calling program
Function round_curr(currValue)
' '
' 'This rounds any currency field
' '
round_curr = currValue
End Function
Your answer for my question has been successed, but it is reading from hundred only and all the invoice having 234.560 KD Fils but reading like this "KUWAITI DINAR 0 Two Hundred Thirty Four and fils 559 only. 1 fils price has reduced and if the invoice more than hundred I mean above thousand it will not read
Pls revert with complete amount read from
Example : Thousand 2348.598 (Kuwaiti Dinar two thousand three hundred forty eight and fils 598 only)
This is your formula :
United Arab Emirates
Here is the code for the conversion :
Example : NumToWord (23.343)
KUWAITI DINAR Twenty Three and FILS 343 only
'=========================
' =====
' '*** This is the main function call
'=========================
' =====
Function NumToWord(numval)
Dim NTW, NText, dollars, cents, NWord, totalcents As String
Dim decplace, TotalSets, cnt, LDollHold As Integer
ReDim NumParts(9) As String 'Array for Amount (sets of three)
ReDim Place(9) As String 'Array containing place holders
Dim LDoll As Integer 'Length of the Dollars Text Amount
Place(2) = " Thousand " '
Place(3) = " Million " 'Place holder names for money
Place(4) = " Billion " 'amounts
Place(5) = " Trillion " '
NTW = "" 'Temp value for the function
NText = round_curr(numval) 'Roundup the cents to eliminate cents gr 2
NText = Trim(Str(NText)) 'String representation of amount
decplace = InStr(Trim(NText), ".") 'Position of decimal 0 if none
dollars = Trim(Left(NText, IIf(decplace = 0, Len(numval), decplace - 1)))
LDoll = Len(dollars)
cents = Trim(Right(NText, IIf(decplace = 0, 0, Abs(decplace - Len(NText)))))
If Len(cents) = 1 Then
cents = cents & "0"
End If
If (LDoll Mod 3) = 0 Then
TotalSets = (LDoll \ 3)
Else
TotalSets = (LDoll \ 3) + 1
End If
cnt = 1
LDollHold = LDoll
Do While LDoll > 0
NumParts(cnt) = IIf(LDoll > 3, Right(dollars, 3), Trim(dollars))
dollars = IIf(LDoll > 3, Left(dollars, (IIf(LDoll < 3, 3, LDoll)) - 3), "")
LDoll = Len(dollars)
cnt = cnt + 1
Loop
For cnt = TotalSets To 1 Step -1 'step through NumParts array
NWord = GetWord(NumParts(cnt)) 'convert 1 element of NumParts
iP1 = InStr(cnt, ".")
NTW = NTW & NWord 'concatenate it to temp variable
If NWord <> "" Then NTW = NTW & Place(cnt)
Next cnt 'loop through
If LDollHold > 0 Then
NTW = "KUWAITI DINAR " & NTW & " and " 'concatenate text
Else
NTW = " NO KUWAITI DINAR " & NTW & " and " 'concatenate text
End If
If Len(cents) > 3 Then
cents = Left(cents, 3)
End If
totalcents = cents 'GetTens(cents) 'Convert cents part to word
If totalcents = "" Then totalfils = "NO" 'Concat NO if cents=0
NTW = NTW & "FILS " & totalcents & " only" 'Concat Dollars and Cents
NumToWord = NTW 'Assign word value to
End Function
'=========================
' ======
' The following function converts a number from 1 to 9 to t
' ext
'=========================
' ======
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "One" '
Case 2: GetDigit = "Two" '
Case 3: GetDigit = "Three" '
Case 4: GetDigit = "Four" ' Assign a numeric word value
Case 5: GetDigit = "Five" ' based on a single digit.
Case 6: GetDigit = "Six" '
Case 7: GetDigit = "Seven" '
Case 8: GetDigit = "Eight" '
Case 9: GetDigit = "Nine" '
Case Else: GetDigit = "" '
End Select
End Function 'End function GetDigit - return to calling program
'=========================
' ======
' The following function converts a number from 10 to 99 to
' text
'=========================
' ======
Function GetTens(tenstext)
Dim GT As String
GT = "" 'null out the temporary function value
If Val(Left(tenstext, 1)) = 1 Then ' If value between 10-19
Select Case Val(tenstext)
Case 10: GT = "Ten" '
Case 11: GT = "Eleven" '
Case 12: GT = "Twelve" '
Case 13: GT = "Thirteen" ' Retrieve numeric word
Case 14: GT = "Fourteen" ' value if between ten and
Case 15: GT = "Fifteen" ' nineteen inclusive.
Case 16: GT = "Sixteen" '
Case 17: GT = "Seventeen" '
Case 18: GT = "Eighteen" '
Case 19: GT = "Nineteen" '
Case Else
End Select
Else ' If value between 20-99
Select Case Val(Left(tenstext, 1))
Case 2: GT = "Twenty " '
Case 3: GT = "Thirty " '
Case 4: GT = "Forty " '
Case 5: GT = "Fifty " ' Retrieve value if it is
Case 6: GT = "Sixty " ' divisible by ten
Case 7: GT = "Seventy " ' excluding the value ten.
Case 8: GT = "Eighty " '
Case 9: GT = "Ninety " '
Case Else
End Select
GT = GT & GetDigit(Right(tenstext, 1)) 'Retrieve ones place
End If
GetTens = GT ' Assign function return value.
End Function
'=========================
' ======
' The following function converts a number from 0 to 999 to
' text
'=========================
' ======
Function GetWord(NumText)
Dim GW As String, x As Integer
GW = "" 'null out temporary function value
If Val(NumText) > 0 Then
For x = 1 To Len(NumText) 'loop the length of NumText times
Select Case Len(NumText)
Case 3:
If Val(NumText) > 99 Then
GW = GetDigit(Left(NumText, 1)) & " Hundred "
End If
NumText = Right(NumText, 2)
Case 2:
GW = GW & GetTens(NumText)
NumText = ""
Case 1:
GW = GetDigit(NumText)
Case Else
End Select
Next x
End If
GetWord = GW 'assign function return value
End Function 'End function GetWord - Return to calling program
Function round_curr(currValue)
' '
' 'This rounds any currency field
' '
round_curr = currValue
End Function
ASKER
Hi dedushka
yes sir, it is OK
yes sir, it is OK
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Hi dedushka
Excellent your answer
Thanks
Do you see my answer to your previous question?
Dedushka