Solved

how to replace ordinal numbers in exisiting word cocuments.

Posted on 2004-10-17
20
358 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
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
 
LVL 9

Expert Comment

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

Featured Post

Ready to get started with anonymous questions?

It's easy! Check out this step-by-step guide for asking an anonymous question on Experts Exchange.

Question has a verified solution.

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

Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
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…
Suggested Courses
Course of the Month7 days, 1 hour left to enroll

622 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