Consulting

Results 1 to 4 of 4

Thread: Find and replace fields in Word using VBA

  1. #1
    VBAX Regular
    Joined
    Mar 2011
    Posts
    88
    Location

    Find and replace fields in Word using VBA

    The following code finds a field in a document (highlighted), deletes it and replaces it with two new fields.

    It seems to work as required, perhaps not as elegantly written as it could be, but it does the job.

    Sub ReplaceFieldsV2()
    
        Application.ScreenUpdating = False
        ActiveWindow.View.ShowFieldCodes = True
        With Selection
            .HomeKey Unit:=wdStory
            .Find.ClearFormatting
            With Selection.Find
                .Text = "^d SEQ Table \* ARABIC"
                .Replacement.Text = ""
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = False
                .MatchWholeWord = False
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
            End With
            .Find.Execute
            .Delete Unit:=wdCharacter, Count:=1
            .TypeText Text:=" "
        
            .Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
                "StyleRef " & """GA Numbered Heading 1""" & " \s", PreserveFormatting:=False
            .TypeText Text:="-"
            Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
                "SEQ " & """Table""" & " \* ARABIC \r 1", PreserveFormatting:=False
        End With
        ActiveWindow.View.ShowFieldCodes = False
        Call SpecialUpdateFields
        Application.ScreenUpdating = True
        
    End Sub
    This procedure just deals with the first field it comes to. What I want to do is for it to move on to the next field, replace it and then so on for all the other similar fields until no more are found.

    I tried researching a For...Loop or a While...Wend but couldn't fathom out where and how to use these. And which would be the best one to employ in this case.

    Could someone point me in the right direction, please?

    Thanks

    Roderick

  2. #2
    I think I would be inclined to loop trough the seq fields themselves e.g. as follows, which should work if the fields are in the body of the document.

    Sub ReplaceFieldsV3()
    'Graham Mayor - http://www.gmayor.com - Last updated - 24 Sep 2018
    Dim oFld As Field, oNewFld As Field
    Dim oRng As Range, oSeq As Range
        For Each oFld In ActiveDocument.Fields
            If oFld.Type = wdFieldSequence Then
                If InStr(1, oFld.Code, "Table") > 0 Then
                    oFld.Code.Text = Replace(oFld.Code.Text, oFld.Code.Text, "SEQ Table \* ARABIC \r 1")
                    oFld.Update
                    Set oRng = oFld.Code
                    oRng.MoveEnd wdCharacter, 1
                    oRng.Collapse 0
                    Set oNewFld = ActiveDocument.Fields.Add(Range:=oRng, _
                                                            Type:=wdFieldStyleRef, _
                                                            Text:="""GA Numbered Heading 1""" & " \s", _
                                                            PreserveFormatting:=False)
                    oNewFld.Update
                End If
            End If
        Next oFld
        ActiveWindow.View.ShowFieldCodes = False
    lbl_Exit:
        Set oFld = Nothing
        Set oNewFld = Nothing
        Set oRng = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word)
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Regular
    Joined
    Mar 2011
    Posts
    88
    Location
    Thanks very much Graham for the great Heads Up and it works as you planned.

    However, the new added wdStyleRef field has to go before the SEQ field and both fields have to be separated by a single dash character. At the moment, the new field goes after the SEQ and there is no gap between these to allow for a hyphen.

    I've tried using using .MoveStart where it says .MoveEnd but this is of course just a character. It has to move (collapse) before the field SEQ then followed by a space.

    You may be asking why this is all necessary? Well, these fields are for creating Table Chapter Headings using special styles and not those imposed by Microsoft (Heading 1, etc). Hence the GA Numbered Heading 1 you see in the code. The end result of course will be (chapter) 1-(item) 1 and so on.

    Is it possible to achieve this structure, please?

    Roderick

  4. #4
    OK. It's just a question of relocating the ranges e.g.

    Sub ReplaceFieldsV4()
    'Graham Mayor - http://www.gmayor.com - Last updated - 25 Sep 2018
    Dim oFld As Field, oNewFld As Field
    Dim oRng As Range, oSeq As Range
        For Each oFld In ActiveDocument.Fields
            If oFld.Type = wdFieldSequence Then
                If InStr(1, oFld.Code, "Table") > 0 Then
                    oFld.Code.Text = Replace(oFld.Code.Text, oFld.Code.Text, "SEQ Table \* ARABIC \r 1")
                    oFld.Update
                    Set oRng = oFld.Code
                    oRng.MoveStart wdCharacter, -1
                    oRng.Collapse 1
                    oRng.Text = "-"
                    oRng.Collapse 1
                    Set oNewFld = ActiveDocument.Fields.Add(Range:=oRng, _
                                                            Type:=wdFieldStyleRef, _
                                                            Text:="""GA Numbered Heading 1""" & " \s", _
                                                            PreserveFormatting:=False)
                    oNewFld.Update
                End If
            End If
        Next oFld
        ActiveWindow.View.ShowFieldCodes = False
    lbl_Exit:
        Set oFld = Nothing
        Set oNewFld = Nothing
        Set oRng = Nothing
        Exit Sub
    End Sub
    Graham Mayor - MS MVP (Word)
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •