Solved

how to replace ordinal numbers in exisiting word cocuments.

Posted on 2004-10-17
20
345 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
Comment Utility
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
Comment Utility
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
Comment Utility
I want to change only numbers like 1st, 2nd, 3rd, 4th on so on to ordinals. Can u help please.
0
 
LVL 9

Expert Comment

by:Shahid Thaika
Comment Utility
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
Comment Utility
No 1st The st should be superscript, 2nd nd should be super script etc.
0
 
LVL 9

Expert Comment

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

Author Comment

by:micazone
Comment Utility
Thanks
0
 
LVL 9

Expert Comment

by:Shahid Thaika
Comment Utility
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
Comment Utility
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
Comment Utility
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
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:micazone
Comment Utility
It works fine. Thanks. Your desrve full points.
0
 
LVL 9

Expert Comment

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

Author Comment

by:micazone
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
This 4th
Stamp 1st
Thursday 4th
Rdonald 3rd
0
 
LVL 9

Expert Comment

by:Shahid Thaika
Comment Utility
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
Comment Utility
O.K. Thank you.
it works fine.
0
 

Author Comment

by:micazone
Comment Utility
0
 
LVL 9

Expert Comment

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

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

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…
Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

771 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now