Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 367
  • Last Modified:

how to replace ordinal numbers in exisiting word cocuments.

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
micazone
Asked:
micazone
  • 10
  • 10
1 Solution
 
Shahid ThaikaCommented:
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
 
Shahid ThaikaCommented:
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
 
micazoneAuthor Commented:
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!

 
Shahid ThaikaCommented:
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
 
micazoneAuthor Commented:
No 1st The st should be superscript, 2nd nd should be super script etc.
0
 
Shahid ThaikaCommented:
oh! That should be simpler. Just give me some time :)
0
 
micazoneAuthor Commented:
Thanks
0
 
Shahid ThaikaCommented:
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
 
micazoneAuthor Commented:
Hi,
Error code 5 at line:
 iFind = InStr(iFind, .Range.Text, "st", vbTextCompare)
Please solve.
0
 
Shahid ThaikaCommented:
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
 
micazoneAuthor Commented:
It works fine. Thanks. Your desrve full points.
0
 
Shahid ThaikaCommented:
Thank You. You just helped me pass the 10k mark :)
0
 
micazoneAuthor Commented:
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
 
micazoneAuthor Commented:
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
 
Shahid ThaikaCommented:
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
 
micazoneAuthor Commented:
This 4th
Stamp 1st
Thursday 4th
Rdonald 3rd
0
 
Shahid ThaikaCommented:
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
 
micazoneAuthor Commented:
O.K. Thank you.
it works fine.
0
 
micazoneAuthor Commented:
0
 
Shahid ThaikaCommented:
I'll give it a try :). Thanks for beleiving in me :).
0

Featured Post

Industry Leaders: 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!

  • 10
  • 10
Tackle projects and never again get stuck behind a technical roadblock.
Join Now