Results 1 to 11 of 11
  1. #1
    5 Star Lounger
    Join Date
    Jul 2003
    Location
    USA
    Posts
    728
    Thanks
    7
    Thanked 2 Times in 2 Posts

    Convert Text to Numbers Macro

    (Word97, SR-2)

    Afternoon,

    Been searching for a macro that will "spell out" the numerical value of text. If I type $1,150,500.50, I would like one million, one hundred fifty thousand, 500 hundred [dollars] and fifty [cents] to appear after the text,formatted with a space, a parens, the numbers, closing parens.

    The currency--dollars, francs, marks, peso, etc.--isn't so important, I can type these in after the numbers appear. Or, if there is a way to have the word dollar and cents, or Francs, etc. in the text, well, that would be beyond grand.

    The numbers can be anywhere from 2 digits up to billions. Is this possible?

    Many thanks for comments and examples!

    ACM

  2. #2
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,852
    Thanks
    4
    Thanked 259 Times in 239 Posts

    Re: Convert Text to Numbers Macro

    There is a field which does this for integers less than one million. You could use that and modify it to provide what you need. Here is some code that came off YE OLDE LOUNGE (I think - although it may have been a Word-Tips newsletter) that helps show how it works.

    <pre>Sub CardText()
    Dim sDigits As String

    ' Select the full number in which the insertion point is located
    Selection.MoveLeft Unit:=wdWord, count:=1, Extend:=wdMove
    Selection.MoveRight Unit:=wdWord, count:=1, Extend:=wdExtend

    ' Store the digits in a variable
    sDigits = Selection.Text

    If Val(sDigits) <= 999999 Then
    ' Create a field containing the digits and the cardtext format flag
    Selection.Fields.Add Range:=Selection.Range, _
    Type:=wdFieldEmpty, Text:="= " + sDigits + " * CardText", _
    PreserveFormatting:=True

    ' Select the field and copy it
    Selection.MoveLeft Unit:=wdCharacter, count:=1, Extend:=wdExtend
    Selection.Copy

    ' Now paste the text as 'unformatted', replacing the selected field
    Selection.PasteSpecial Link:=False, DataType:=wdPasteText, _
    Placement:=wdInLine, DisplayAsIcon:=False

    ' Add space after words
    Selection.TypeText Text:=" "
    Else
    MsgBox "Number too large", vbOKOnly
    End If
    End Sub</pre>

    Andrew Lockton, Chrysalis Design, Melbourne Australia

  3. #3
    5 Star Lounger
    Join Date
    Jul 2003
    Location
    USA
    Posts
    728
    Thanks
    7
    Thanked 2 Times in 2 Posts

    Re: Convert Text to Numbers Macro

    Andrew - Thank you very much for your information. When I ran your supplied code, I got a Compile Error on line that read If Val(sDigits) <= 999999 Then.

    I think I may have misspoken in what I want: I don

  4. #4
    5 Star Lounger
    Join Date
    Jul 2003
    Location
    USA
    Posts
    728
    Thanks
    7
    Thanked 2 Times in 2 Posts

    Re: Convert Text to Numbers Macro

    OOps - meant to say the original macro was in WordBasic...

  5. #5
    3 Star Lounger
    Join Date
    Jan 2001
    Location
    Brisbane, Australia
    Posts
    245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Convert Text to Numbers Macro

    Hi Acerf

    I located the following macro about six months ago and I gather it does what you are after I think.

    I apologise to the author as I seem to have lost the details but someone from the Lounge might recognise it and set me straight.

    "This macro has a nasty habit of deleting any number tested if it is >999,999"

    "Sub NumberToWords()
    Dim Number As Long
    Dim Words As String
    Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
    If IsNumeric(Selection) Then
    Number = CLng(Selection)
    Select Case Number
    Case 0
    Words = "Zero"
    Case 1 To 999999
    Words = SetThousands(Number)
    Case Else
    MsgBox "Number too large!", vbExclamation, "NumberToWords Macro"
    End Select
    Else
    MsgBox "No number to left of insertion point!", _
    vbExclamation, "NumberToWords Macro"
    End If
    Selection = Words
    End Sub

    Private Function SetOnes(ByVal Number As Integer) As String
    Dim OnesArray(9) As String
    OnesArray(1) = "One"
    OnesArray(2) = "Two"
    OnesArray(3) = "Three"
    OnesArray(4) = "Four"
    OnesArray(5) = "Five"
    OnesArray(6) = "Six"
    OnesArray(7) = "Seven"
    OnesArray(8) = "Eight"
    OnesArray(9) = "Nine"
    SetOnes = OnesArray(Number)
    End Function

    Private Function SetTens(ByVal Number As Integer) As String
    Dim TensArray(9) As String
    TensArray(1) = "Ten"
    TensArray(2) = "Twenty"
    TensArray(3) = "Thirty"
    TensArray(4) = "Fourty"
    TensArray(5) = "Fifty"
    TensArray(6) = "Sixty"
    TensArray(7) = "Seventy"
    TensArray(8) = "Eighty"
    TensArray(9) = "Ninety"
    Dim TeensArray(9) As String
    TeensArray(1) = "Eleven"
    TeensArray(2) = "Twelve"
    TeensArray(3) = "Thirteen"
    TeensArray(4) = "Fourteen"
    TeensArray(5) = "Fifteen"
    TeensArray(6) = "Sixteen"
    TeensArray(7) = "Seventeen"
    TeensArray(8) = "Eighteen"
    TeensArray(9) = "Nineteen"
    Dim tmpInt1 As Integer
    Dim tmpInt2 As Integer
    Dim tmpString As String
    tmpInt1 = Int(Number / 10)
    tmpInt2 = Int(Number Mod 10)
    tmpString = TensArray(tmpInt1)
    If (tmpInt1 = 1 And tmpInt2 > 0) Then
    tmpString = TeensArray(tmpInt2)
    Else
    If (tmpInt1 > 1 And tmpInt2 > 0) Then
    tmpString = tmpString + " " + SetOnes(tmpInt2)
    End If
    End If
    SetTens = tmpString
    End Function

    Private Function SetHundreds(ByVal Number As Integer) As String
    Dim tmpInt1 As Integer
    Dim tmpInt2 As Integer
    Dim tmpString As String
    tmpInt1 = Int(Number / 100)
    tmpInt2 = Int(Number Mod 100)
    If tmpInt1 > 0 Then tmpString = SetOnes(tmpInt1) + " Hundred"
    If tmpInt2 > 0 Then
    If tmpString > "" Then tmpString = tmpString + " "
    If tmpInt2 < 10 Then tmpString = tmpString + SetOnes(tmpInt2)
    If tmpInt2 > 9 Then tmpString = tmpString + SetTens(tmpInt2)
    End If
    SetHundreds = tmpString
    End Function

    Private Function SetThousands(ByVal Number As Long) As String
    Dim tmpInt1 As Integer
    Dim tmpInt2 As Integer
    Dim tmpString As String
    tmpInt1 = Int(Number / 1000)
    tmpInt2 = Int(Number Mod 1000)
    If tmpInt1 > 0 Then tmpString = SetHundreds(tmpInt1) + " Thousand"
    If tmpInt2 > 0 Then
    If tmpString > "" Then tmpString = tmpString + " "
    tmpString = tmpString + SetHundreds(tmpInt2)
    End If
    SetThousands = tmpString
    End Function"

    Remove quotes from code (only added to indicate original author's text and code) before testing.

    Whilst I haven't run Andrew's response, the code he shows is leaner than the above. Both lots of code refer to numbers less that 1 million - is this a VBA limit I wonder?

    Leigh

  6. #6
    Super Moderator
    Join Date
    Jan 2001
    Location
    Melbourne, Victoria, Australia
    Posts
    3,852
    Thanks
    4
    Thanked 259 Times in 239 Posts

    Re: Convert Text to Numbers Macro

    The If Val(sDigits)... line is only stopping large numbers and you could delete it and the "End If" line at the end if you wanted to test that code.

    I will have a look at yours and the other supplied code but won't be able to do it for a few days - blasted Chicken Pox has hit the family. What version of Word do you want this to work for? How big are the numbers you might come up with?
    Andrew Lockton, Chrysalis Design, Melbourne Australia

  7. #7
    5 Star Lounger
    Join Date
    Jul 2003
    Location
    USA
    Posts
    728
    Thanks
    7
    Thanked 2 Times in 2 Posts

    Re: Convert Text to Numbers Macro

    Andrew, sorry to hear that "pox on your house" has become too true for you!

    I'm using Word97, SR-2. If posible, I'd like the numbers to go up to a billion & the number after the decimal to be spelled out.

    My thanks for your patience with me.

  8. #8
    Star Lounger
    Join Date
    Jan 2001
    Location
    Adelaide, South Australia, Australia
    Posts
    85
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Convert Text to Numbers Macro

    If anyone wants the text version of REALLY big numbers, (Bill Gates, maybe) there's a Perl script available from Landon Curt Noll at
    http://www.isthe.com/chongo/tech/mat...er/number.html
    which can convert numbers of any size. I imagine it could be converted to VB if someone had the time [img]/w3timages/icons/smile.gif[/img].

    Ian.

  9. #9
    Platinum Lounger
    Join Date
    Dec 2000
    Location
    Queanbeyan, New South Wales, Australia
    Posts
    3,730
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Convert Text to Numbers Macro

    Andrew,

    I'd be careful hanging around this lounge. Look what's happened to Leif.
    Subway Belconnen- home of the Signboard to make you smile. Get (almost) daily updates- follow SubwayBelconnen on Twitter.

  10. #10
    3 Star Lounger rcbjr2's Avatar
    Join Date
    Jan 2001
    Location
    Matthews, NC
    Posts
    279
    Thanks
    6
    Thanked 1 Time in 1 Post

    Re: Convert Text to Numbers Macro

    Here is a macro I created a while back. It will work up to $1 billion, I believe, although it has trouble with certain numbers that are all zeroes. I once found a macro on the web somewhere, called something like "Say" macros, or maybe that was one of the macros they had, but it was a very sophisticated conversion macro. I'll keep trying to find it.

    Sub CtrlMF()
    '
    ' Ctrl+M,F Macro
    ' Ctrl+M,F = Convert Numbers to Words
    '
    Dim vOrigNum As String, vOrigNumPercent As String, vDollar As Integer
    Dim vPercent As Integer, vDecimal As Integer, vStrLeft As String
    Dim vStrLeftLen As Integer, vStrRight As String, vStrRightLen As Integer
    Dim vStrChar As String, vStrHoldStr As String, vStrHoldStrLen As Integer
    Dim vStrLeftMil As String, vStrLeftBil As String
    Dim vStrLeftThou As String, vSrrLeftHun As String

    If Selection.Type = wdSelectionIP Then 'Selects numbers to left of IP
    Selection.MoveStartWhile Cset:="0123456789$%.,-", Count:=wdBackward
    End If

    vOrigNum = Selection.Text 'Assigns selection to variable
    vOrigNumLen = Len(vOrigNum) 'Sets length of selected number to variable
    vDollar = InStr(1, vOrigNum, "$") 'Checks to see if number is dollar figure
    vPercent = InStr(1, vOrigNum, "%") 'Checks to see if number is a percent
    vMinus = InStr(1, vOrigNum, "-") 'Checks to see if number is negative

    If vMinus <> 0 Then
    If vDollar <> 0 Then 'If a dollar amount, then Caps; otherwise, lowercase
    Selection.TypeText Text:="Minus " 'Types Minus if no. is negative
    Else
    Selection.TypeText Text:="minus " 'Types minus if no. is negative
    End If
    End If

    For i = 1 To vOrigNumLen 'Strips all but numbers from variable
    vStrChar = Mid$(vOrigNum, i, 1)
    Select Case vStrChar
    Case ",", "$", "%", "-"
    Case Else
    vStrHoldStr = vStrHoldStr & vStrChar
    End Select 'Stripped number assigned to new variable
    Next i

    vStrHoldStrLen = Len(vStrHoldStr) 'Checks length of stripped number
    vDecimal = InStr(1, vStrHoldStr, ".") 'Checks to see if number includes decimal

    'If number includes decimal, assigns zeros if needed to the left or right
    If vDecimal <> 0 Then
    vStrLeft = Mid(vStrHoldStr, 1, vDecimal - 1)
    If vStrLeft = "" Then
    vStrLeft = "0" 'Adds left zero for ".87" type number
    End If
    If vStrHoldStrLen - vDecimal = "0" Then
    vStrRight = "0" 'Adds right zero for "87." type number
    If vDollar <> 0 Then vStrRight = "00" 'Adds two zeros for "$87." type number
    Else
    vStrRight = Mid(vStrHoldStr, vDecimal + 1, vStrHoldStrLen - vDecimal)
    End If 'Assigns actual numbers to vStrRight if they exist
    End If

    If vDecimal = 0 Then 'If there is no decimal, assigns number to vStrLeft
    vStrLeft = vStrHoldStr
    vStrRight = "0" 'and adds 0 or 00, as appropriate, to vStrRight
    If vDollar <> 0 Then vStrRight = "00"
    End If

    vStrLeftLen = Len(vStrLeft) 'Assigns length of vStrLeft to vStrLeftLen

    If vStrLeftLen > 12 Then GoTo GreaterThanBillion 'If > billion, exit

    'If billions, strip billions string and insert into doc using Field
    If vStrLeftLen > 9 Then
    'Start at position 1, move right Length - 9 positions
    vStrLeftBil = Mid(vStrLeft, 1, vStrLeftLen - 9)
    'Assign leftover string to vStrLeft, start at Length-8, move 9 positions
    vStrLeft = Mid(vStrLeft, vStrLeftLen - 8, 9)
    vStrLeftLen = Len(vStrLeft)
    If vDollar <> 0 Then 'If a dollar amount, then Caps; otherwise, lowercase
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
    Text:="= " + vStrLeftBil + " * CardText * Caps", _
    PreserveFormatting:=True
    Selection.TypeText Text:=" Billion "
    Else
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
    Text:="= " + vStrLeftBil + " * CardText", _
    PreserveFormatting:=True
    Selection.TypeText Text:=" billion "
    End If
    Else
    GoTo CheckMillions 'If no billions, check millions
    End If

    CheckMillions:
    'If millions, strip millions string and insert into doc using Field
    If vStrLeftLen > 6 Then
    'Start at position 1, move right Length - 6 positions
    vStrLeftMil = Mid(vStrLeft, 1, vStrLeftLen - 6)
    'Assign leftover string to vStrLeft, start Length-5, move 6 positions
    vStrLeft = Mid(vStrLeft, vStrLeftLen - 5, 6)
    vStrLeftLen = Len(vStrLeft)
    If vDollar <> 0 Then 'If a dollar amount, then Caps; otherwise, lowercase
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
    Text:="= " + vStrLeftMil + " * CardText * Caps", _
    PreserveFormatting:=True
    Selection.TypeText Text:=" Million "
    Else
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
    Text:="= " + vStrLeftMil + " * CardText", _
    PreserveFormatting:=True
    Selection.TypeText Text:=" million "
    End If
    Else
    GoTo DoThousands 'If no millions, do hundred thousands
    End If

    DoThousands:
    'If decimal, but not dollar, insert left/right Fields using "point"
    If vDecimal <> 0 And vDollar = 0 Then
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
    Text:="= " + vStrLeft + " * CardText", _
    PreserveFormatting:=True 'Removed '* Caps to use lowercase
    Selection.TypeText " point "
    vStrRightLen = Len(vStrRight)
    For i = 1 To vStrRightLen 'Individually insert each right side number
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
    Text:="= " + Mid(vStrRight, i, 1) + " * CardText", _
    PreserveFormatting:=True 'Removed * Caps to use lowercase
    Selection.TypeText Text:=" "
    Next i
    Selection.TypeBackspace
    End If

    'If not decimal, and not dollar, just insert Field for number words
    If vDecimal = 0 And vDollar = 0 Then
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
    Text:="= " + vStrLeft + " * CardText", _
    PreserveFormatting:=True 'Removed * Caps to use lowercase
    End If

    'If percent, but not dollar, insert word "Percent"
    If vPercent <> 0 And vDollar = 0 Then
    Selection.TypeText Text:=" percent"
    End If

    'If dollar, insert Fields for left/right numbers w/decimal point and "Dollars"
    If vDollar <> 0 Then
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
    Text:="= " + vStrLeft + "." + vStrRight + " * DollarText * Caps", _
    PreserveFormatting:=True
    Selection.TypeText Text:=" Dollars"
    End If

    Selection.TypeText Text:=" (" 'Type parenthesis and actual number into doc
    If vMinus <> 0 Then Selection.TypeText Text:="-" 'Add minus symbol
    If vDollar <> 0 Then Selection.TypeText Text:="$" 'Add dollar symbol
    'Type billions and millions followed by comma
    If vStrLeftBil <> "" Then Selection.TypeText Text:=vStrLeftBil + ","
    If vStrLeftMil <> "" Then Selection.TypeText Text:=vStrLeftMil + ","
    If vStrLeftLen > 3 Then 'Insert hundred thousands with comma
    vStrLeftThou = Mid(vStrLeft, 1, vStrLeftLen - 3)
    vStrLeft = Mid(vStrLeft, vStrLeftLen - 2, 3)
    Selection.TypeText Text:=vStrLeftThou + ","
    End If
    Selection.TypeText Text:=vStrLeft 'Insert remaining hundreds
    'Add decimal point if vDecimal or vDollar is true
    If vDecimal <> 0 Or vDollar <> 0 Then Selection.TypeText Text:="."
    Selection.TypeText Text:=vStrRight 'Insert right side string
    'Remove trailing 0 if vDecimal is 0 (assigned in first routine above
    'to assign vStrLeft & vStrRight
    If vDecimal = 0 And vStrRight = "0" Then Selection.TypeBackspace
    If vPercent <> 0 Then Selection.TypeText Text:="%" 'Add percent symbol
    Selection.TypeText Text:=")" 'Insert closing parenthesis

    GoTo SkipBillionError 'Jumps over GreaterThanBillion error message

    GreaterThanBillion: 'GreaterThanBillion error message
    ret = MsgBox("Number is Greater than 999,999,999,999.99!" + vbCr + "Macro will now terminate.", vbOKOnly + vbExclamation, "NumConv Macro Error!")

    SkipBillionError: 'Ends macro

    End Sub

  11. #11
    5 Star Lounger
    Join Date
    Jul 2003
    Location
    USA
    Posts
    728
    Thanks
    7
    Thanked 2 Times in 2 Posts

    Re: Convert Text to Numbers Macro

    Thank you very, very much for your macro. It's great to know that an original posting so old still gets read -- and responded to.

    I tried searching the web for such a macro but had no luck. So, again, my thanks! ACM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •