Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Converting Numbers to Text and Numbers

210 views
Skip to first unread message

CJ

unread,
Aug 25, 2004, 2:59:08 PM8/25/04
to
I'm using Word 2003 on XP. Does anyone know of a macro
that will take numbers and convert them to text and
numbers?. For example, $5.00 could be converted to Five
Dollars and No Cents ($5.00) or 180 would be converted to
One Hundred Eighty (180). We are moving from WP to Word
and the WP macro that does this is very nifty and I was
hoping someone had created the same thing in Word.

Thanks for your help.

CJ

Doug Robbins

unread,
Aug 25, 2004, 8:09:11 PM8/25/04
to
Function ConvertCurrencyToEnglish(ByVal MyNumber)
Dim Temp
Dim Dollars, Cents
Dim DecimalPlace, Count


ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "

MyNumber = Trim(Str(MyNumber))

DecimalPlace = InStr(MyNumber, ".")
If DecimalPlace > 0 Then
Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
Cents = ConvertTens(Temp)
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
'convert last 3 digits to English Dollars
Temp = ConvertHundreds(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
If Len(MyNumber) > 3 Then
'remove last 3 comverted digits
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop

'clean up dollars
Select Case Dollars
Case ""
Dollars = "NoDollars"
Case "One"
Dollars = "One Dollar"
Case Else
Dollars = Dollars & " Dollars"
End Select

'clean up cents
Select Case Cents
Case ""
Cents = " And No Cents"
Case "One"
Cents = " And One Cent"
Case Else
Cents = " And " & Cents & " Cents"
End Select
ConvertCurrencyToEnglish = Dollars & Cents
End Function
=================================================
Private Function ConvertHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function

'append leading zeros to number
MyNumber = Right("000" & MyNumber, 3)

'do we have hundreds place digit to convert?
If Left(MyNumber, 1) <> "0" Then
Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
End If

'do we have tens place digit to convert?
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & ConvertTens(Mid(MyNumber, 2))
Else
'if not, then convert the ones place digit
Result = Result & ConvertDigit(Mid(MyNumber, 3))
End If
ConvertHundreds = Trim(Result)
End Function
======================================================
Private Function ConvertTens(ByVal MyTens)
Dim Result As String
'is value between 10 and 19?
If Val(Left(MyTens, 1)) = 1 Then
Select Case Val(MyTens)
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
Select Case Val(Left(MyTens, 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

'convert ones place digit
Result = Result & ConvertDigit(Right(MyTens, 1))
End If
ConvertTens = Result
End Function
======================================================
Private Function ConvertDigit(ByVal MyDigit)
Select Case Val(MyDigit)
Case 1: ConvertDigit = "One"
Case 2: ConvertDigit = "Two"
Case 3: ConvertDigit = "Three"
Case 4: ConvertDigit = "Four"
Case 5: ConvertDigit = "Five"
Case 6: ConvertDigit = "Six"
Case 7: ConvertDigit = "Seven"
Case 8: ConvertDigit = "Eight"
Case 9: ConvertDigit = "Nine"
Case Else: ConvertDigit = ""
End Select
End Function
===========================================================
Sub TestAboveFunction()
Dim MyNumber
MyNumber = 551521896.32
MsgBox ConvertCurrencyToEnglish(ByVal MyNumber)
End Sub
===========================================================


--
Please respond to the Newsgroup for the benefit of others who may be
interested. Questions sent directly to me will only be answered on a paid
consulting basis.

Hope this helps,
Doug Robbins - Word MVP
"CJ" <anon...@discussions.microsoft.com> wrote in message
news:016001c48ad5$997e39b0$a301...@phx.gbl...

CJ

unread,
Aug 26, 2004, 11:19:20 AM8/26/04
to
Wow! Thanks so much Doug. I appreciate the help.

CJ

>.
>

CJ

unread,
Aug 26, 2004, 4:35:11 PM8/26/04
to
Thanks for your help Doug. Your function is pretty close
to what I want, but I actually need something that will
take the number "109" in a document and replace that text
with the following text: One Hundred Nine (109) and the
differentiate between simple numbers and currency. I
would like to position the cursor either to the right or
left of the number and then run the macro. I'm pretty
new to VB, so please be gentle. Thanks.

CJ

>.
>

Doug Robbins

unread,
Aug 26, 2004, 8:20:37 PM8/26/04
to
If you select the number and run the following macro it will convert it to
text

Dim strnumber As String
Set myrange = Selection.Range
strnumber = myrange.Text
ActiveDocument.Fields.Add Range:=myrange, Type:=wdFieldEmpty, Text:="=" &
strnumber & "\* cardtext"
ActiveDocument.Fields.Update


--
Please respond to the Newsgroup for the benefit of others who may be
interested. Questions sent directly to me will only be answered on a paid
consulting basis.

Hope this helps,
Doug Robbins - Word MVP
"CJ" <anon...@discussions.microsoft.com> wrote in message

news:02c501c48bac$2efffa60$a401...@phx.gbl...

0 new messages