Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 1
Default Modified VB Code for Converting Number to Text


Hi Patrick & Bob
Thanx for the reply and the suggestions.
Bob, I've tried your code & it works fine. But still I want to modif
one thing. I've made some little changes and pasting the code wit
this reply. This code will give good result. This code will give "On
Lakh Rupees and Paise Zero Only" for 100000, but I want it like this
Rupees One Lakh and Paise Zero Only" and for 10000000 it will give
One Hundred Lakh Rupees and Zero Paise" this I want like this " Rupee
One Crore and Paise Zero only". Please modify the attached code an
reply back. Do u have any idea about converting Numerals to Text i
"MS Word" (in Tables). Anyway thanx once again.
shashi


Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Lakhs, Rupees, Paise, Temp
Dim DecimalPlace, Count As Long
Dim myLakhs
ReDim Place(9) As String
Place(2) = " Thousand "
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 Paise and set MyNumber to Rupees amount.
If DecimalPlace 0 Then
Paise = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If

myLakhs = MyNumber \ 100000
MyNumber = MyNumber - myLakhs * 100000
Count = 1
Do While myLakhs < ""
Temp = GetHundreds(Right(myLakhs, 3))
If Temp < "" Then Lakhs = Temp & Place(Count) & Lakhs
If Len(myLakhs) 3 Then
myLakhs = Left(myLakhs, Len(myLakhs) - 3)
Else
myLakhs = ""
End If
Count = Count + 1
Loop

Count = 1
Do While MyNumber < ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp < "" Then Rupees = Temp & Place(Count) & Rupees
If Len(MyNumber) 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop

Select Case Lakhs
Case "": Lakhs = ""
Case "One": Lakhs = " One Lakh "
Case Else: Lakhs = Lakhs & " Lakhs "
End Select

Select Case Rupees
Case "": Rupees = "Rupees Zero "
Case "One": Rupees = "Rupee One"
Case Else: Rupees = "Rupees " & Rupees
End Select


Select Case Paise
Case "": Paise = " and Paise Zero Only "
Case "One": Paise = " and Paise One Only "
Case Else: Paise = " and " & " Paise " & Paise & " Only "
End Select

SpellNumber = Lakhs & Rupees & Paise

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 = "Ten"
Case 11: Result = "Eleven"
Case 12: Result = "Twelve"
Case 13: Result = "Thirteen"
Case 14: Result = "Fourteen"
Case 15: Result = "Fifteen"
Case 16: Result = "Sixteen"
Case 17: Result = "Seventeen"
Case 18: Result = "Eighteen"
Case 19: Result = "Nineteen"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "Twenty "
Case 3: Result = "Thirty "
Case 4: Result = "Forty "
Case 5: Result = "Fifty "
Case 6: Result = "Sixty "
Case 7: Result = "Seventy "
Case 8: Result = "Eighty "
Case 9: Result = "Ninety "
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 = "One"
Case 2: GetDigit = "Two"
Case 3: GetDigit = "Three"
Case 4: GetDigit = "Four"
Case 5: GetDigit = "Five"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Seven"
Case 8: GetDigit = "Eight"
Case 9: GetDigit = "Nine"
Case Else: GetDigit = ""
End Select
End Function


--
shashidharga
------------------------------------------------------------------------
shashidharga's Profile: http://www.excelforum.com/member.php...o&userid=14922
View this thread: http://www.excelforum.com/showthread...hreadid=265827

  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 11,272
Default Modified VB Code for Converting Number to Text

Shashidharga,

I am not clear how the results should be structured.

Can you tell me what these values should return

123.45
1234.56
12345.67
123456.78
1234567.89
12345678.90
10045678.90


--

HTH

RP

"shashidharga" wrote in message
...

Hi Patrick & Bob
Thanx for the reply and the suggestions.
Bob, I've tried your code & it works fine. But still I want to modify
one thing. I've made some little changes and pasting the code with
this reply. This code will give good result. This code will give "One
Lakh Rupees and Paise Zero Only" for 100000, but I want it like this "
Rupees One Lakh and Paise Zero Only" and for 10000000 it will give "
One Hundred Lakh Rupees and Zero Paise" this I want like this " Rupees
One Crore and Paise Zero only". Please modify the attached code and
reply back. Do u have any idea about converting Numerals to Text in
"MS Word" (in Tables). Anyway thanx once again.
shashi


Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Lakhs, Rupees, Paise, Temp
Dim DecimalPlace, Count As Long
Dim myLakhs
ReDim Place(9) As String
Place(2) = " Thousand "
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 Paise and set MyNumber to Rupees amount.
If DecimalPlace 0 Then
Paise = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If

myLakhs = MyNumber \ 100000
MyNumber = MyNumber - myLakhs * 100000
Count = 1
Do While myLakhs < ""
Temp = GetHundreds(Right(myLakhs, 3))
If Temp < "" Then Lakhs = Temp & Place(Count) & Lakhs
If Len(myLakhs) 3 Then
myLakhs = Left(myLakhs, Len(myLakhs) - 3)
Else
myLakhs = ""
End If
Count = Count + 1
Loop

Count = 1
Do While MyNumber < ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp < "" Then Rupees = Temp & Place(Count) & Rupees
If Len(MyNumber) 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop

Select Case Lakhs
Case "": Lakhs = ""
Case "One": Lakhs = " One Lakh "
Case Else: Lakhs = Lakhs & " Lakhs "
End Select

Select Case Rupees
Case "": Rupees = "Rupees Zero "
Case "One": Rupees = "Rupee One"
Case Else: Rupees = "Rupees " & Rupees
End Select


Select Case Paise
Case "": Paise = " and Paise Zero Only "
Case "One": Paise = " and Paise One Only "
Case Else: Paise = " and " & " Paise " & Paise & " Only "
End Select

SpellNumber = Lakhs & Rupees & Paise

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 = "Ten"
Case 11: Result = "Eleven"
Case 12: Result = "Twelve"
Case 13: Result = "Thirteen"
Case 14: Result = "Fourteen"
Case 15: Result = "Fifteen"
Case 16: Result = "Sixteen"
Case 17: Result = "Seventeen"
Case 18: Result = "Eighteen"
Case 19: Result = "Nineteen"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "Twenty "
Case 3: Result = "Thirty "
Case 4: Result = "Forty "
Case 5: Result = "Fifty "
Case 6: Result = "Sixty "
Case 7: Result = "Seventy "
Case 8: Result = "Eighty "
Case 9: Result = "Ninety "
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 = "One"
Case 2: GetDigit = "Two"
Case 3: GetDigit = "Three"
Case 4: GetDigit = "Four"
Case 5: GetDigit = "Five"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Seven"
Case 8: GetDigit = "Eight"
Case 9: GetDigit = "Nine"
Case Else: GetDigit = ""
End Select
End Function


--
shashidharga
------------------------------------------------------------------------
shashidharga's Profile:

http://www.excelforum.com/member.php...o&userid=14922
View this thread: http://www.excelforum.com/showthread...hreadid=265827



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Converting a text word or text string to a number Tom Excel Discussion (Misc queries) 6 January 2nd 09 08:23 PM
converting text to number Julio Excel Worksheet Functions 1 December 8th 06 06:47 PM
Converting number to text rslater44 Excel Discussion (Misc queries) 1 March 2nd 06 09:56 PM
Converting Text to Number Andrew Bartholomew Excel Discussion (Misc queries) 1 March 25th 05 02:50 AM
Modified VB Code for Converting Number to Text shashidharga[_3_] Excel Programming 4 October 3rd 04 01:11 PM


All times are GMT +1. The time now is 03:11 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"