Link to home
Create AccountLog in
Avatar of jeffwhiteexpert
jeffwhiteexpertFlag for United States of America

asked on

How Can I Convert a Number to Text in Microsoft Word 2003?

I am using Quickbooks Point of Sale 7.0 and one of the functions that it has is to create templates with Microsoft Word to write letters to customers, etc using different variables from Quickbooks.  For example, in the header of a refund check to a customer that I am making, on the template it displays «CompanyName» and «CompanyAddress».  When the letter is written, Quickbooks fills in those variables with the correct information.  To get the dollar amount for the check, I am subtracting «AccountLimit» and «AccountBalance» by nesting these two in a formula field, which can be done with the Alt + F9 toggle.

It looks like this:
{ = { MERGEFIELD AccountLimit } - { MERGEFIELD AccountBalance } }

That works fine and it gives me a number (i.e. $23.46).  

Now starts my question:  How can I convert that number to text format like you write in a check (i.e. twenty three dollars and forty six cents) using Microsoft Word 2003?
ASKER CERTIFIED SOLUTION
Avatar of GrahamSkan
GrahamSkan
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
Create a free account to see this answer
Signing up is free and takes 30 seconds. No credit card required.
See answer
Try the following code which you can find at http://www.ozgrid.com/VBA/CurrencyToWords.htm

Put the code in the code snippet in a module

Enter ConvertCurrencyToEnglish(A1) to convert number in A1 to currency in words.

Curt
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 "
 
 
 
         ' Convert MyNumber to a string, trimming extra spaces.
 
         MyNumber = Trim(Str(MyNumber))
 
 
 
         ' Find decimal place.
 
         DecimalPlace = InStr(MyNumber, ".")
 
 
 
         ' If we find decimal place...
 
         If DecimalPlace > 0 Then
 
            ' Convert cents
 
            Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
 
            Cents = ConvertTens(Temp)
 
 
 
            ' Strip off cents from remainder to convert.
 
            MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
 
         End If
 
 
 
         Count = 1
 
         Do While MyNumber <> ""
 
            ' Convert last 3 digits of MyNumber to English dollars.
 
            Temp = ConvertHundreds(Right(MyNumber, 3))
 
            If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
 
            If Len(MyNumber) > 3 Then
 
               ' Remove last 3 converted digits from MyNumber.
 
               MyNumber = Left(MyNumber, Len(MyNumber) - 3)
 
            Else
 
               MyNumber = ""
 
            End If
 
            Count = Count + 1
 
         Loop
 
 
 
         ' Clean up dollars.
 
         Select Case Dollars
 
            Case ""
 
               Dollars = "No Dollars"
 
            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
 
 
 
         ' Exit if there is nothing to convert.
 
         If Val(MyNumber) = 0 Then Exit Function
 
 
 
         ' Append leading zeros to number.
 
         MyNumber = Right("000" & MyNumber, 3)
 
 
 
         ' Do we have a hundreds place digit to convert?
 
         If Left(MyNumber, 1) <> "0" Then
 
            Result = ConvertDigit(Left(MyNumber, 1)) & " Hundred "
 
         End If
 
 
 
         ' Do we have a 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
 
            ' .. otherwise it's between 20 and 99.
 
            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

Open in new window

Oops this was for Excel. Maybe not so good for Word?

Curt
Avatar of jeffwhiteexpert

ASKER

Thanks, that is just what I was looking for.
Too late but here is a macro that will convert a selected numerical value to text with Dollar and Cents in the end. This macro is a modification of the macro found at http://www.discussweb.com/vb-net-programming/2714-how-create-word-macro-converts-currency-numbers-into-words.html

Open MSword
Click file>close (no more open documents)
Click tools>macros>Visual basic editor
On the left hand side tree-view, expand 'normal'>'Microsoft word objects' to see 'ThisDocument'
Double click on 'ThisDocument'
A white (probably blank) window will appear on the
right hand side, where you should paste the following code
Close all the windows. Installation is complete!

Now when you are typing a document,
if want to use the converter,
Select the number which you want to convert.
Press Alt+F8.
Press Enter. (check for 'RSconvert' in 'Macro name' text field)
This will replace the selected number with its
word equivalent

Curt
Dim arrSingleDigit
Dim arrTeen
Dim arrTwoDigits
Sub RSconvert()
On Error Resume Next
arrSingleDigit = Array("one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten")
arrTeen = Array("eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen", "twenty")
arrTwoDigits = Array("10", "twenty ", "thirty ", "forty ", "fifty ", "sixty ", "seventy ", "eighty ", "ninety ", "Hundred")
 
valdig = Trim("" + Selection.Text)
If valdig = "" Or IsNumeric(valdig) = False Then Exit Sub
valInDigits = valdig
cents = Int(valInDigits * 100 - Int(valInDigits) * 100)
valInDigits = Int(valInDigits)
 
If valInDigits > 0 Then
If valInDigits > 999999999 Then
MsgBox "Beyond Limit"
Else
msgtmp = convert(valInDigits) + " Dollars"
If cents <> 0 Then msgtmp = msgtmp + " and " + convert(cents) + " Cents"
msgtmp = UCase(Left(msgtmp, 1)) + Right(msgtmp, Len(msgtmp) - 1)
Selection.Text = msgtmp
Exit Sub
End If
End If
End Sub
Private Function convert(valInDigits)
Dim MSB
Dim LSB
If valInDigits > 0 And valInDigits < 10 Then
converted = arrSingleDigit(valInDigits - 1)
 
ElseIf valInDigits = 10 Then
converted = "ten"
 
ElseIf ((valInDigits > 10) And (valInDigits < 20)) Then
converted = arrTeen(valInDigits Mod 10 - 1)
 
ElseIf ((valInDigits >= 20) And (valInDigits <= 99)) Then
MSB = valInDigits \ 10
converted = arrTwoDigits(MSB - 1)
LSB = valInDigits Mod 10
If LSB > 0 Then
converted = converted + convert(LSB)
End If
 
ElseIf ((valInDigits >= 100) And (valInDigits <= 999)) Then
MSB = valInDigits \ 100
converted = convert(MSB) + " " + "hundred"
LSB = valInDigits Mod 100
If LSB > 0 Then
converted = converted + " " + convert(LSB)
End If
 
ElseIf ((valInDigits >= 999) And (valInDigits <= 99999)) Then
MSB = valInDigits \ 1000
converted = convert(MSB) + " " + "thousand"
LSB = valInDigits Mod 1000
If LSB > 0 Then
converted = converted + " " + convert(LSB)
End If
 
ElseIf ((valInDigits >= 99999) And (valInDigits <= 999999)) Then
MSB = valInDigits \ 100000
converted = convert(MSB) + " " + "hundred"
LSB = valInDigits Mod 100000
If LSB > 0 Then
converted = converted + " " + convert(LSB)
End If
 
ElseIf ((valInDigits >= 999999) And (valInDigits <= 999999999)) Then
MSB = valInDigits \ 1000000
converted = convert(MSB) + " " + "million"
LSB = valInDigits Mod 1000000
If LSB > 0 Then
converted = converted + " " + convert(LSB)
End If
 
'ElseIf ((valInDigits >= 999999999) And (valInDigits <= 999999999999#)) Then
'MSB = valInDigits \ 1000000000
'converted = convert(MSB) + " " + "billion"
'LSB = valInDigits Mod 1000000000
'If LSB > 0 Then
'converted = converted + " " + convert(LSB)
'End If
End If
convert = converted
End Function

Open in new window