Solved

how to replace ordinal numbers in exisiting word cocuments.

Posted on 2004-10-17
20
353 Views
Last Modified: 2010-05-02
We have to replace sertain numbers to ordinal numbers in multiple word documents. Can any one suggest a VB script for the same.
Shyam
0
Comment
Question by:micazone
  • 10
  • 10
20 Comments
 
LVL 9

Expert Comment

by:Shahid Thaika
ID: 12332818
Are you searching for digits (1, 34, 103) or numbers in words (One, Thirty four, One hunder and Three), etc... If it is in digits, I can help you. :)
0
 
LVL 9

Expert Comment

by:Shahid Thaika
ID: 12333185
I had written this code to convert digits into word form few years back... I have made some changes so that it can give output in ordinals

------------------------------------------------------------------------------------------------------------
Public inMillion As Boolean

Public Function NumToText(Number As Long, Optional LastLEN As Integer, Optional Calling As Boolean) As String
Dim L As Integer
'If Not Supports(Number) Then
    'NumToText = "NA"
    'Exit Function
'End If
L = Len(LTrim$(RTrim$(Str(Number))))
Select Case L
    Case Is < 3
        If LastLEN > 3 Then NumToText = "and "
        Select Case Number
            Case 0
                NumToText = NumToText & "zero"
            Case 1
                NumToText = NumToText & "first"
            Case 2
                NumToText = NumToText & "second"
            Case 3
                NumToText = NumToText & "third"
            Case 4
                NumToText = NumToText & "fourth"
            Case 5
                NumToText = NumToText & "fifth"
            Case 6
                NumToText = NumToText & "sixth"
            Case 7
                NumToText = NumToText & "seventh"
            Case 8
                NumToText = NumToText & "eighth"
            Case 9
                NumToText = NumToText & "ningth"
            Case 10
                NumToText = NumToText & "tenth"
            Case 11
                NumToText = NumToText & "eleventh"
            Case 12
                NumToText = NumToText & "twelfth"
            Case 13
                NumToText = NumToText & "thirteenth"
            Case 14
                NumToText = NumToText & "fourteenth"
            Case 15
                NumToText = NumToText & "fifteenth"
            Case 16
                NumToText = NumToText & "sixteenth"
            Case 17
                NumToText = NumToText & "seventeenth"
            Case 18
                NumToText = NumToText & "eighteenth"
            Case 19
                NumToText = NumToText & "nineteenth"
            Case 20
                NumToText = NumToText & "twenty"
            Case 30
                NumToText = NumToText & "thirty"
            Case 40
                NumToText = NumToText & "forty"
            Case 50
                NumToText = NumToText & "fifty"
            Case 60
                NumToText = NumToText & "sixty"
            Case 70
                NumToText = NumToText & "seventy"
            Case 80
                NumToText = NumToText & "eighty"
            Case 90
                NumToText = NumToText & "ninety"
            Case Else
                NumToText = NumToText & NumToText(Left(Number, 1) * 10) & " " & NumToText(Right(Number, 1))
        End Select
       
    Case 3
        If Right(Number, 2) = 0 Then
            NumToText = NumToText(Left(Number, 1)) & " hundred"
            Exit Function
        End If
       
        NumToText = NumToText(Left(Number, 1)) & " hundred and " & NumToText(Right(Number, 2))
   
    Case 4
        If Right(Number, 3) = 0 Then
            NumToText = NumToText(Left(Number, 1)) & " thousand"
            Exit Function
        End If
        NumToText = NumToText(Left(Number, 1)) & " thousand " & NumToText(Right(Number, 3), L)
   
    Case 5
        If Right(Number, 4) = 0 Then
            NumToText = NumToText(Left(Number, 2)) & " thousand"
            Exit Function
        End If
        NumToText = NumToText(Left(Number, 2)) & " thousand " & NumToText(Right(Number, 3), L)
       
    Case 6
        If Not inMillion Then
            If Right(Number, 5) = 0 Then
                NumToText = NumToText(Left(Number, 1)) & " lakh"
                Exit Function
            End If
            NumToText = NumToText(Left(Number, 1)) & " lakh " & NumToText(Right(Number, 5), L)
        Else
            If Right(Number, 5) = 0 Then
                NumToText = NumToText(Left(Number, 3)) & " thousand"
                Exit Function
            End If
            NumToText = NumToText(Left(Number, 3)) & " thousand " & NumToText(Right(Number, 3), L)
        End If
       
    Case 7
        If Not inMillion Then
            If Right(Number, 6) = 0 Then
                NumToText = NumToText(Left(Number, 2)) & " lakh"
                Exit Function
            End If
            NumToText = NumToText(Left(Number, 2)) & " lakh " & NumToText(Right(Number, 5), L)
        Else
            If Right(Number, 6) = 0 Then
                NumToText = NumToText(Left(Number, 1)) & " million"
                Exit Function
            End If
            NumToText = NumToText(Left(Number, 1)) & " million " & NumToText(Right(Number, 6), L)
        End If
End Select
End Function

Public Function Supports(Number As Long) As Boolean
Supports = (Number >= 0 And Number <= 9999)
End Function
--------------------------------------------------------------------------------------------------------

If you are searching for digits and know the numbers you are looking for, you can do the following...

Search for the number in the word document, use the number to get the word form and replace the found number in word form. However you may have to make some changes in the above code. I haven't modified it for your need completely. It assumes that there are no zeros in the number. So if the number is 101... it will show Hundred and first, but if the number is 100, then it will show hundred.

Please make adjustments if needed. Hope this answers your question.
0
 

Author Comment

by:micazone
ID: 12358671
I want to change only numbers like 1st, 2nd, 3rd, 4th on so on to ordinals. Can u help please.
0
Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

 
LVL 9

Expert Comment

by:Shahid Thaika
ID: 12360348
Do you mean finding 1st and replacing it with first, finding 2nd and replacing it with second... etc...?

In that case, it should be simpler! :)
0
 

Author Comment

by:micazone
ID: 12366420
No 1st The st should be superscript, 2nd nd should be super script etc.
0
 
LVL 9

Expert Comment

by:Shahid Thaika
ID: 12366680
oh! That should be simpler. Just give me some time :)
0
 

Author Comment

by:micazone
ID: 12368506
Thanks
0
 
LVL 9

Expert Comment

by:Shahid Thaika
ID: 12371703
I beleive this is what you are looking for...



--------------------------------------------------------------------------------------------------
Private WApp As New Word.Application
Private WDoc As Word.Document

Private Sub Form_Load()
Dim Cnt As Integer
Dim Cnt2 As Integer
Dim iFind As Integer

'Open the document
Set WDoc = WApp.Documents.Open("D:\temp.doc")

'Check for st (First) in every paragraph.
For Cnt = 1 To WDoc.Paragraphs.Count
    With WDoc.Paragraphs(Cnt)
            iFind = 1
            'Look for any 'st' in the paragraph
            iFind = InStr(iFind, .Range.Text, "st", vbTextCompare)
            While iFind <> 0
                'see if the previous charecter is a number.
                'the st could also be in a 'first' or 'fist'!
                If IsNumeric(Mid(.Range.Text, iFind - 1, 1)) Then
                    'change is to superscript
                    .Range.Characters(iFind).Font.Superscript = True
                    .Range.Characters(iFind + 1).Font.Superscript = True
                End If
                iFind = iFind + 1
                'find the next 'st'
                iFind = InStr(iFind, .Range.Text, "st", vbTextCompare)
            Wend
    End With
Next Cnt

'Do the above for 'nd'
For Cnt = 1 To WDoc.Paragraphs.Count
    With WDoc.Paragraphs(Cnt)
            iFind = 1
            iFind = InStr(iFind, .Range.Text, "nd", vbTextCompare)
            While iFind <> 0
                If IsNumeric(Mid(.Range.Text, iFind - 1, 1)) Then
                    .Range.Characters(iFind).Font.Superscript = True
                    .Range.Characters(iFind + 1).Font.Superscript = True
                End If
                iFind = iFind + 1
                iFind = InStr(iFind, .Range.Text, "nd", vbTextCompare)
            Wend
    End With
Next Cnt

'Do the above for 'rd'
For Cnt = 1 To WDoc.Paragraphs.Count
    With WDoc.Paragraphs(Cnt)
            iFind = 1
            iFind = InStr(iFind, .Range.Text, "rd", vbTextCompare)
            While iFind <> 0
                If IsNumeric(Mid(.Range.Text, iFind - 1, 1)) Then
                    .Range.Characters(iFind).Font.Superscript = True
                    .Range.Characters(iFind + 1).Font.Superscript = True
                End If
                iFind = iFind + 1
                iFind = InStr(iFind, .Range.Text, "rd", vbTextCompare)
            Wend
    End With
Next Cnt

'Do the above for 'th'
For Cnt = 1 To WDoc.Paragraphs.Count
    With WDoc.Paragraphs(Cnt)
            iFind = 1
            iFind = InStr(iFind, .Range.Text, "th", vbTextCompare)
            While iFind <> 0
                If IsNumeric(Mid(.Range.Text, iFind - 1, 1)) Then
                    .Range.Characters(iFind).Font.Superscript = True
                    .Range.Characters(iFind + 1).Font.Superscript = True
                End If
                iFind = iFind + 1
                iFind = InStr(iFind, .Range.Text, "th", vbTextCompare)
            Wend
    End With
Next Cnt

WDoc.Save
WDoc.Close
WApp.Quit

Set WDoc = Nothing
Set WApp = Nothing

Unload Me
End Sub
0
 

Author Comment

by:micazone
ID: 12377793
Hi,
Error code 5 at line:
 iFind = InStr(iFind, .Range.Text, "st", vbTextCompare)
Please solve.
0
 
LVL 9

Accepted Solution

by:
Shahid Thaika earned 250 total points
ID: 12378075
Does this solve the problem...




Private WApp As New Word.Application
Private WDoc As Word.Document

Private Sub Form_Load()
Dim Cnt As Integer
Dim Cnt2 As Integer
Dim iFind As Integer

'Open the document
Set WDoc = WApp.Documents.Open("D:\temp.doc")

'Check for st (First) in every paragraph.
For Cnt = 1 To WDoc.Paragraphs.Count
    With WDoc.Paragraphs(Cnt)
            iFind = 1
            'Look for any 'st' in the paragraph
            iFind = InStr(iFind, .Range.Text, "st", vbTextCompare)
            While iFind <> 0
                'see if the previous charecter is a number.
                'the st could also be in a 'first' or 'fist'!
                If IsNumeric(Mid(.Range.Text, iFind - 1, 1)) Then
                    'change is to superscript
                    .Range.Characters(iFind).Font.Superscript = True
                    .Range.Characters(iFind + 1).Font.Superscript = True
                End If
                iFind = iFind + 1
                'find the next 'st'
                iFind = InStr(iFind, .Range.Text, "st", vbTextCompare)
            Wend
    End With
Next Cnt

'Do the above for 'nd'
For Cnt = 1 To WDoc.Paragraphs.Count
    With WDoc.Paragraphs(Cnt)
            iFind = 1
            iFind = InStr(iFind, .Range.Text, "nd", vbTextCompare)
            While iFind > 1
                If IsNumeric(Mid(.Range.Text, iFind - 1, 1)) Then
                    .Range.Characters(iFind).Font.Superscript = True
                    .Range.Characters(iFind + 1).Font.Superscript = True
                End If
                iFind = iFind + 1
                iFind = InStr(iFind, .Range.Text, "nd", vbTextCompare)
            Wend
    End With
Next Cnt

'Do the above for 'rd'
For Cnt = 1 To WDoc.Paragraphs.Count
    With WDoc.Paragraphs(Cnt)
            iFind = 1
            iFind = InStr(iFind, .Range.Text, "rd", vbTextCompare)
            While iFind > 1
                If IsNumeric(Mid(.Range.Text, iFind - 1, 1)) Then
                    .Range.Characters(iFind).Font.Superscript = True
                    .Range.Characters(iFind + 1).Font.Superscript = True
                End If
                iFind = iFind + 1
                iFind = InStr(iFind, .Range.Text, "rd", vbTextCompare)
            Wend
    End With
Next Cnt

'Do the above for 'th'
For Cnt = 1 To WDoc.Paragraphs.Count
    With WDoc.Paragraphs(Cnt)
            iFind = 1
            iFind = InStr(iFind, .Range.Text, "th", vbTextCompare)
            While iFind > 1
                If IsNumeric(Mid(.Range.Text, iFind - 1, 1)) Then
                    .Range.Characters(iFind).Font.Superscript = True
                    .Range.Characters(iFind + 1).Font.Superscript = True
                End If
                iFind = iFind + 1
                iFind = InStr(iFind, .Range.Text, "th", vbTextCompare)
            Wend
    End With
Next Cnt

WDoc.Save
WDoc.Close
WApp.Quit

Set WDoc = Nothing
Set WApp = Nothing

Unload Me
End Sub








I found a problem Maybe the sentence started with 'St'. Actually the if statement is checking for a number before the 'st', 'nd', 'rd' or 'th'. So if it is a word like 'This', or 'Start', it will try to look for character '0' and returns an error.

If you still have an error, type '?.Range.Text' in the Immediate window and please post the text.
0
 

Author Comment

by:micazone
ID: 12378733
It works fine. Thanks. Your desrve full points.
0
 
LVL 9

Expert Comment

by:Shahid Thaika
ID: 12379134
Thank You. You just helped me pass the 10k mark :)
0
 

Author Comment

by:micazone
ID: 12380058
Sorry to remind again.
The problem still persists with words starting
 with ST,TH,RD and ND.
I have tried putting ? as advised but did not work.
Kindly solve this problem.
0
 

Author Comment

by:micazone
ID: 12381553
Possibly
If IsNumeric(Mid(.Range.Text, iFind - 1, 1))  OR NULL can solve this problem. Please excuse me I am not a programmer or expert therefore I have used NULL to show nothing neither numeric or chracter.
Thanks
0
 
LVL 9

Expert Comment

by:Shahid Thaika
ID: 12381902
Did you use the code where the while loop is 'While iFind > 1' instead of While iFind <> 0. I possible, can you upload your document somewhere?


This was my logic to use 'While iFind > 1' instead of While iFind <> 0...
If ST, ND, RD or TH would be found anywhere in the middle then ok...
But if found in the beginning... example: as in STart, THis, etc..., then iFind would have the value 1.
The Mid function would try to find the charector at (iFind - 1) which will actually be charector #0 (error).

Hence, I used While iFind > 1 in the new code.

If you cannot upload the document, can you give me the sentence in which you are having a problem. I'll run the code with it and try to figure out the exact problem. You can find the current paragraph text by looking for the value of 'WDoc.Paragraphs(Cnt).Range.Text.
0
 

Author Comment

by:micazone
ID: 12382286
This 4th
Stamp 1st
Thursday 4th
Rdonald 3rd
0
 
LVL 9

Expert Comment

by:Shahid Thaika
ID: 12382825
Ok, found one more problem. If ST, etc.. are in the beginning, the code doesn't search the remaining para. Try this code...





Private WApp As New Word.Application
Private WDoc As Word.Document

Private Sub Form_Load()
Dim Cnt As Integer
Dim Cnt2 As Integer
Dim iFind As Integer

'Open the document
Set WDoc = WApp.Documents.Open("D:\temp.doc")

'Check for st (First) in every paragraph.
For Cnt = 1 To WDoc.Paragraphs.Count
    With WDoc.Paragraphs(Cnt)
            iFind = 1
            'Look for any 'st' in the paragraph
            iFind = InStr(iFind, .Range.Text, "st", vbTextCompare)
            'If the paragraph starts with 'st', check the remaining paragraph
            If iFind = 1 Then iFind = InStr(iFind + 1, .Range.Text, "st", vbTextCompare)
            While iFind <> 0
                'see if the previous charecter is a number.
                'the st could also be in a 'first' or 'fist'!
                If IsNumeric(Mid(.Range.Text, iFind - 1, 1)) Then
                    'change is to superscript
                    .Range.Characters(iFind).Font.Superscript = True
                    .Range.Characters(iFind + 1).Font.Superscript = True
                End If
                'find the next 'st'
                iFind = InStr(iFind + 1, .Range.Text, "st", vbTextCompare)
            Wend
    End With
Next Cnt

'Do the above for 'nd'
For Cnt = 1 To WDoc.Paragraphs.Count
    With WDoc.Paragraphs(Cnt)
            iFind = 1
            iFind = InStr(iFind, .Range.Text, "nd", vbTextCompare)
            If iFind = 1 Then iFind = InStr(iFind + 1, .Range.Text, "nd", vbTextCompare)
            While iFind <> 0
                If IsNumeric(Mid(.Range.Text, iFind - 1, 1)) Then
                    .Range.Characters(iFind).Font.Superscript = True
                    .Range.Characters(iFind + 1).Font.Superscript = True
                End If
                iFind = InStr(iFind + 1, .Range.Text, "nd", vbTextCompare)
            Wend
    End With
Next Cnt

'Do the above for 'rd'
For Cnt = 1 To WDoc.Paragraphs.Count
    With WDoc.Paragraphs(Cnt)
            iFind = 1
            iFind = InStr(iFind, .Range.Text, "rd", vbTextCompare)
            If iFind = 1 Then iFind = InStr(iFind + 1, .Range.Text, "rd", vbTextCompare)
            While iFind <> 0
                If IsNumeric(Mid(.Range.Text, iFind - 1, 1)) Then
                    .Range.Characters(iFind).Font.Superscript = True
                    .Range.Characters(iFind + 1).Font.Superscript = True
                End If
                iFind = InStr(iFind + 1, .Range.Text, "rd", vbTextCompare)
            Wend
    End With
Next Cnt

'Do the above for 'th'
For Cnt = 1 To WDoc.Paragraphs.Count
    With WDoc.Paragraphs(Cnt)
            iFind = 1
            iFind = InStr(iFind, .Range.Text, "th", vbTextCompare)
            If iFind = 1 Then iFind = InStr(iFind + 1, .Range.Text, "th", vbTextCompare)
            While iFind <> 0
                If IsNumeric(Mid(.Range.Text, iFind - 1, 1)) Then
                    .Range.Characters(iFind).Font.Superscript = True
                    .Range.Characters(iFind + 1).Font.Superscript = True
                End If
                iFind = InStr(iFind + 1, .Range.Text, "th", vbTextCompare)
            Wend
    End With
Next Cnt

WDoc.Save
WDoc.Close
WApp.Quit

Set WDoc = Nothing
Set WApp = Nothing

Unload Me
End Sub
0
 

Author Comment

by:micazone
ID: 12386979
O.K. Thank you.
it works fine.
0
 

Author Comment

by:micazone
ID: 12387288
0
 
LVL 9

Expert Comment

by:Shahid Thaika
ID: 12388305
I'll give it a try :). Thanks for beleiving in me :).
0

Featured Post

Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Introduction In a recent article (http://www.experts-exchange.com/A_7811-A-Better-Concatenate-Function.html) for the Excel community, I showed an improved version of the Excel Concatenate() function.  While writing that article I realized that no o…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

776 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question