Numbering after a word (code not following an order)

[nmc]

I have the following code and I wanted to every word "ARTICLE" that is founded in the word file add a number in order to create a numbering (e.g: ARTICLE 1 : , ARTICLE 2 : , ARTICLE 3 , etc)
But the following code is not following an order and can't recognize the words that are in bold

j
Sub AddNumberToName()
    'Declare variables
    Dim doc As Object
    Dim range As Object
    Dim i As Integer
    
    'Open the Word document
    Set doc = CreateObject("Word.Application")
    doc.Documents.Open ("C:\UserData\Documents\article.docx")
    
    'Get the range of the document
    Set range = doc.ActiveDocument.Content
    
    'Loop through each word in the range
    For i = 1 To range.Words.Count
        'Check if the word is "Name"
        If range.Words(i) = "ARTICLE" Then
            'Add the number to the word
            range.Words(i).Text = "ARTICLE " & (i \ 2) + 1 & " :"
        End If
    Next i
    
    'Save and close the document
    doc.ActiveDocument.Save
    doc.ActiveDocument.Close
    
    'Quit Word
    doc.Quit
End Sub

 

[NdNoviceHlp]

Hi nmc. It seems like you could just use some type of find and replace. Please keep a copy of your document before trialing this code. HTH. Dave

Sub AddNumberToName()
    'Declare variables
    Dim Odoc As Object
    Dim Orange As Object
    Dim cnt As Integer
    Dim Artcnt As Integer, Splitter As Variant, NewStr As String
    'Open the Word document
    Set Odoc = CreateObject("Word.Application")
    Odoc.Documents.Open ("C:\UserData\Documents\article.docx")
    'Get the range of the document
    Set Orange = Odoc.ActiveDocument.Content
    'separate words by " "
    Splitter = Split(Orange.Text, " ")
    NewStr = vbNullString
    'create new doc contents
    For cnt = LBound(Splitter) To UBound(Splitter)
    If LCase(Splitter(cnt)) = LCase("Article") Then
    Artcnt = Artcnt + 1
    NewStr = NewStr & "ARTICLE " & CStr(Artcnt) & " :" & " "
    Else
    NewStr = NewStr & Splitter(cnt) & " "
    End If
    Next cnt
    'clear doc then add new contents
    With Odoc.ActiveDocument
    .range(0, .Characters.Count).Delete
    .Content.InsertAfter Left(NewStr, Len(NewStr) - 1)
    End With
    'Save and close the document
    Odoc.ActiveDocument.Save
    Odoc.ActiveDocument.Close
    'Quit Word
    Odoc.Quit
    Set Odoc = Nothing
End Sub

ps. using Range and/or Doc are not good variable names as they have set meanings for XL

 

[NdNoviceHlp]

This is better. The word object contains the word and trailing spaces so you have to trim them out. Dave

Sub AddNumberToName()
    'Declare variables
    Dim WrdApp As Object
    Dim ObjRng As Object
    Dim i As Integer, Artcnt As Integer
    'Open the Word document
    Set WrdApp = CreateObject("Word.Application")
    WrdApp.Documents.Open ("C:\UserData\Documents\article.docx")
    'Get the range of the document
    Set ObjRng = WrdApp.ActiveDocument.Content
    For i = 1 To ObjRng.Words.Count
        If RTrim(ObjRng.Words(i)) = "ARTICLE" Then
          Artcnt = Artcnt + 1
            'Add the number to the word
            ObjRng.Words(i).Text = "ARTICLE " & CStr(Artcnt) & " :"
        End If
    Next i
    'Save and close the document
    WrdApp.ActiveDocument.Save
    WrdApp.ActiveDocument.Close
    'Quit Word
    WrdApp.Quit
    Set WrdApp = Nothing
End Sub

 

[nmc]

Thanks for your Help and attention.
I Saw that the ranges of texts that I have in This file from any external file that Also have ARTICLE word are not being consider to insert the numbering. I'm doing something wrong? Thanks

 

[NdNoviceHlp]

Are the ranges being inserted as html or as pictures instead of text? Did you also trial the code from #2? Dave

 

[nmc]

The second code that you provided worked !! Thanks

 

[NdNoviceHlp]

You are welcome. Thanks for posting your outcome. Dave