Convert numbers to words

R

Ravi

Hi....By using the below function...If am giving 123.45 it returns "One
Hundred Twenty Three Point Four Five" instead of this i need "One Hundred
Twenty Three and Fourty Five Paise Only"....is this possible please
help.......because daily we are printing around 250 cheques and we are
entering the words manually in excel.

Private sNumberText() As String

Public Function NumberAsText(NumberIn As Variant, _
Optional AND_or_CHECK_or_DOLLAR As String) As String
Dim cnt As Long
Dim DecimalPoint As Long
Dim CardinalNumber As Long
Dim CommaAdjuster As Long
Dim TestValue As Long
Dim CurrValue As Currency
Dim CentsString As String
Dim NumberSign As String
Dim WholePart As String
Dim BigWholePart As String
Dim DecimalPart As String
Dim tmp As String
Dim sStyle As String
Dim bUseAnd As Boolean
Dim bUseCheck As Boolean
Dim bUseDollars As Boolean
'----------------------------------------
' Begin setting conditions for formatting
'----------------------------------------
' Determine whether to apply special formatting.
' If nothing passed, return routine result
' converted only into its numeric equivalents,
' with no additional format text.
sStyle = LCase(AND_or_CHECK_or_DOLLAR)
' User passed "AND": "and" will be added
' between hundredths and tens of dollars,
' ie "Three Hundred and Forty Two"
bUseAnd = sStyle = "and"
' User passed "DOLLAR": "dollar(s)" and "cents"
' appended to string,
' ie "Three Hundred and Forty Two Dollars"
bUseDollars = sStyle = "dollar"
' User passed "CHECK" *or* "DOLLAR"
' If "check", cent amount returned as a fraction /100
' i.e. "Three Hundred Forty Two and 00/100"
' If "dollar" was passed, "dollar(s)" and "cents"
' Appended instead.
bUseCheck = (sStyle = "check") Or (sStyle = "dollar")
'----------------------------------------
' Check/create array. If this is the first
' time using this routine, create the text
' strings that will be used.
'----------------------------------------
If Not IsBounded(sNumberText) Then
Call BuildArray(sNumberText)
End If
'----------------------------------------
' Begin validating the number, and breaking
' into constituent parts
'----------------------------------------
' Prepare to check for valid value in
NumberIn = Trim$(NumberIn)
If Not IsNumeric(NumberIn) Then
' Invalid entry - abort
NumberAsText = "Error - Number improperly formed"
Exit Function
Else
' Decimal check
DecimalPoint = InStr(NumberIn, ".")
If DecimalPoint > 0 Then
' Split the fractional and primary numbers
DecimalPart = Mid$(NumberIn, DecimalPoint + 1)
WholePart = Left$(NumberIn, DecimalPoint - 1)
Else
' Assume the decimal is the last char
DecimalPoint = Len(NumberIn) + 1
WholePart = NumberIn
End If
If InStr(NumberIn, ",,") Or _
InStr(NumberIn, ",.") Or _
InStr(NumberIn, ".,") Or _
InStr(DecimalPart, ",") Then
NumberAsText = "Error - Improper use of commas"
Exit Function
ElseIf InStr(NumberIn, ",") Then
CommaAdjuster = 0
WholePart = ""
For cnt = DecimalPoint - 1 To 1 Step -1
If Not Mid$(NumberIn, cnt, 1) Like "[,]" Then
WholePart = Mid$(NumberIn, cnt, 1) & WholePart
Else
CommaAdjuster = CommaAdjuster + 1
If (DecimalPoint - cnt - CommaAdjuster) Mod 3 Then
NumberAsText = "Error - Improper use of commas"
Exit Function
End If
End If
Next
End If
End If
If Left$(WholePart, 1) Like "[+-]" Then
NumberSign = IIf(Left$(WholePart, 1) = "-", "Minus ", "Plus ")
WholePart = Mid$(WholePart, 2)
End If
'----------------------------------------
' Begin code to assure decimal portion of
' check value is not inadvertently rounded
'----------------------------------------
If bUseCheck = True Then
CurrValue = CCur(Val("." & DecimalPart))
DecimalPart = Mid$(Format$(CurrValue, "0.00"), 3, 2)
If CurrValue >= 0.995 Then
If WholePart = String$(Len(WholePart), "9") Then
WholePart = "1" & String$(Len(WholePart), "0")
Else
For cnt = Len(WholePart) To 1 Step -1
If Mid$(WholePart, cnt, 1) = "9" Then
Mid$(WholePart, cnt, 1) = "0"
Else
Mid$(WholePart, cnt, 1) = _
CStr(Val(Mid$(WholePart, cnt, 1)) + 1)
Exit For
End If
Next
End If
End If
End If
'----------------------------------------
' Final prep step - this assures number
' within range of formatting code below
'----------------------------------------
If Len(WholePart) > 9 Then
BigWholePart = Left$(WholePart, Len(WholePart) - 9)
WholePart = Right$(WholePart, 9)
End If
If Len(BigWholePart) > 9 Then
NumberAsText = "Error - Number too large"
Exit Function
ElseIf Not WholePart Like String$(Len(WholePart), "#") Or _
(Not BigWholePart Like String$(Len(BigWholePart), "#") _
And Len(BigWholePart) > 0) Then
NumberAsText = "Error - Number improperly formed"
Exit Function
End If
'----------------------------------------
' Begin creating the output string
'----------------------------------------
' Very Large values
TestValue = Val(BigWholePart)
If TestValue > 999999 Then
CardinalNumber = TestValue \ 1000000
tmp = HundredsTensUnits(CardinalNumber) & "Quadrillion "
TestValue = TestValue - (CardinalNumber * 1000000)
End If
If TestValue > 999 Then
CardinalNumber = TestValue \ 1000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Trillion "
TestValue = TestValue - (CardinalNumber * 1000)
End If
If TestValue > 0 Then
tmp = tmp & HundredsTensUnits(TestValue) & "Billion "
End If
' Lesser values
TestValue = Val(WholePart)
If TestValue = 0 And BigWholePart = "" Then tmp = "Zero "
If TestValue > 999999 Then
CardinalNumber = TestValue \ 1000000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Million "
TestValue = TestValue - (CardinalNumber * 1000000)
End If
If TestValue > 999 Then
CardinalNumber = TestValue \ 1000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Thousand "
TestValue = TestValue - (CardinalNumber * 1000)
End If
If TestValue > 0 Then
If Val(WholePart) < 99 And BigWholePart = "" Then bUseAnd = False
tmp = tmp & HundredsTensUnits(TestValue, bUseAnd)
End If
' If in dollar mode, assure the text is the correct plurality
If bUseDollars = True Then
CentsString = HundredsTensUnits(DecimalPart)
If tmp = "One " Then
tmp = tmp & "Dollar"
Else
tmp = tmp & "Dollars"
End If
If Len(CentsString) > 0 Then
tmp = tmp & " and " & CentsString
If CentsString = "One " Then
tmp = tmp & "Cent"
Else
tmp = tmp & "Cents"
End If
End If
ElseIf bUseCheck = True Then
tmp = tmp & "and " & Left$(DecimalPart & "00", 2)
tmp = tmp & "/100"
Else
If Len(DecimalPart) > 0 Then
tmp = tmp & "Point"
For cnt = 1 To Len(DecimalPart)
tmp = tmp & " " & sNumberText(Mid$(DecimalPart, cnt, 1))
Next
End If
End If
' Done!
NumberAsText = NumberSign & tmp
End Function

Private Sub BuildArray(sNumberText() As String)
ReDim sNumberText(0 To 27) As String
sNumberText(0) = "Zero"
sNumberText(1) = "One"
sNumberText(2) = "Two"
sNumberText(3) = "Three"
sNumberText(4) = "Four"
sNumberText(5) = "Five"
sNumberText(6) = "Six"
sNumberText(7) = "Seven"
sNumberText(8) = "Eight"
sNumberText(9) = "Nine"
sNumberText(10) = "Ten"
sNumberText(11) = "Eleven"
sNumberText(12) = "Twelve"
sNumberText(13) = "Thirteen"
sNumberText(14) = "Fourteen"
sNumberText(15) = "Fifteen"
sNumberText(16) = "Sixteen"
sNumberText(17) = "Seventeen"
sNumberText(18) = "Eighteen"
sNumberText(19) = "Nineteen"
sNumberText(20) = "Twenty"
sNumberText(21) = "Thirty"
sNumberText(22) = "Forty"
sNumberText(23) = "Fifty"
sNumberText(24) = "Sixty"
sNumberText(25) = "Seventy"
sNumberText(26) = "Eighty"
sNumberText(27) = "Ninety"
End Sub

Private Function IsBounded(vntArray As Variant) As Boolean
' Note: the application in the IDE will stop
' at this line when first run if the IDE error
' mode is not set to "Break on Unhandled Errors"
' (Tools/Options/General/Error Trapping)
On Error Resume Next
IsBounded = IsNumeric(UBound(vntArray))
End Function

Private Function HundredsTensUnits(ByVal TestValue As Integer, _
Optional bUseAnd As Boolean) As String
Dim CardinalNumber As Integer
If TestValue > 99 Then
CardinalNumber = TestValue \ 100
HundredsTensUnits = sNumberText(CardinalNumber) & " Hundred "
TestValue = TestValue - (CardinalNumber * 100)
End If
If bUseAnd = True Then
HundredsTensUnits = HundredsTensUnits & "and "
End If
If TestValue > 20 Then
CardinalNumber = TestValue \ 10
HundredsTensUnits = HundredsTensUnits & _
sNumberText(CardinalNumber + 18) & " "
TestValue = TestValue - (CardinalNumber * 10)
End If
If TestValue > 0 Then
HundredsTensUnits = HundredsTensUnits & _
sNumberText(TestValue) & " "
End If
End Function

thanks
ravi kumar
 
M

muddan madhu

Source ( Microsoft Office ) http://support.microsoft.com/kb/213360

only dollar changed to rupees

Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim rupees, paise, Temp
Dim DecimalPlace, Count
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 cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
paise = 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 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 rupees
Case ""
rupees = "no rupees"
Case "One"
rupees = "One "
Case Else
rupees = rupees & "rupees"
End Select
Select Case paise
Case ""
paise = " and No paise"

Case "One"
paise = " and One piase"
Case Else
paise = " and " & paise & "paise"
End Select
SpellNumber = 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
 
R

Ravi

thanks a tonnnnnnnnnnnnn

muddan madhu said:
Source ( Microsoft Office ) http://support.microsoft.com/kb/213360

only dollar changed to rupees

Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim rupees, paise, Temp
Dim DecimalPlace, Count
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 cents and set MyNumber to dollar amount.
If DecimalPlace > 0 Then
paise = 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 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 rupees
Case ""
rupees = "no rupees"
Case "One"
rupees = "One "
Case Else
rupees = rupees & "rupees"
End Select
Select Case paise
Case ""
paise = " and No paise"

Case "One"
paise = " and One piase"
Case Else
paise = " and " & paise & "paise"
End Select
SpellNumber = 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
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

how to use towords formula 1
Remove Identical words 0
VBA Export to PDF 0
Input Box 2
Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0
VBA - exporting serial letters to single documents 0
Extract Text in braquet and list of terms from 2 Docs 3
Make VBA ComboBox_Change work in 3 sheets 1

Top