Consulting

Results 1 to 4 of 4

Thread: Error when inserting a field

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

    Error when inserting a field

    This is a macro developed earlier by Graham Mayor for which I'm very grateful and which works superbly well up to a point identified below - but only because I've "messed around" with it to try and achieve a solution.

    Here is the macro:
    Sub ReplaceFieldsV4()
        'Graham Mayor - http://www.gmayor.com - Last updated - 24 Sep 2018
        '===================================
        'this procedure ensures that all the Standard Numbering SEQ fields have the \s option set
        'irrespective of what had been put there earlier.
        Dim oFld As Field, oNewFld As Field
        Dim oRng As Range, oSeq As Range
        Dim figRng As Range, figLvl As Long
        
        ActiveWindow.View.ShowFieldCodes = True
        For Each oFld In ActiveDocument.Fields
            If oFld.Type = wdFieldSequence Then
                If InStr(1, oFld.Code, "Figure") > 0 Then
                    oFld.Select
                    'this procedure inserts a Chapter Figure caption based on Word Headings levels
                    With Selection
                        Set figRng = .Range
                        Set figRng = figRng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
                        figLvl = Right(figRng.Paragraphs.First.Style, 1)
                    End With
                    oFld.Code.Text = Replace(oFld.Code.Text, oFld.Code.Text, "SEQ Figure \* ARABIC \s \* MERGEFORMAT")
                    oFld.Update
                    Set oRng = oFld.Code
                    With Selection
                    .MoveLeft Unit:=wdCharacter, Count:=1
                    .TypeText Text:="-"
                    .Collapse
                    .MoveLeft Unit:=wdCharacter, Count:=1
                    End With
                    'now adds the StyleRef field
                    Set oNewFld = ActiveDocument.Fields.Add(Range:=.Range, _
                        Type:=wdFieldEmpty, _
                        Text:="StyleRef ""Heading " & figLvl & """ \s", _
                        PreserveFormatting:=False)
                    oNewFld.Update
                    Set oRng = oNewFld
                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
    What should happen is that a StyRef field should be inserted before the SEQ field, however, and error kicks in at this position here (in red):

                    Set oNewFld = ActiveDocument.Fields.Add(Range:=.Range, _
                        Type:=wdFieldEmpty, _
                        Text:="StyleRef ""Heading " & figLvl & """ \s", _
                        PreserveFormatting:=False)
                    oNewFld.Update
                    Set oRng = oNewFld
    ...and this is the error message which appears:

    Capture.PNG

    I've tried "fiddling" with possible permutations to get the field added but don't seem to have the correct procedure to get it right.

    Could the correct code be pointed out me, please, to achieve the process?

    Thanks

    Roderick

  2. #2
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    2,888
    Location
    Sub ReplaceFieldsV4()
    Dim oFld As Field, oNewFld As Field
    Dim oRng As Range, oSeq As Range
    Dim figRng As Range, figLvl As Long
      ActiveWindow.View.ShowFieldCodes = True
      For Each oFld In ActiveDocument.Fields
         If oFld.Type = wdFieldSequence Then
           If InStr(1, oFld.Code, "Figure") > 0 Then
             oFld.Select
             With Selection
               Set figRng = .Range
               Set figRng = figRng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
               figLvl = Right(figRng.Paragraphs.First.Style, 1)
             End With
             oFld.Code.Text = Replace(oFld.Code.Text, oFld.Code.Text, "SEQ Figure \* ARABIC \s \* MERGEFORMAT")
             oFld.Update
             Set oRng = oFld.Code
             With Selection
               .MoveLeft Unit:=wdCharacter, Count:=1
               .TypeText Text:="-"
               .Collapse
               .MoveLeft Unit:=wdCharacter, Count:=1
             'End With 'Move  ...
              Set oNewFld = ActiveDocument.Fields.Add(Range:=.Range, _
              Type:=wdFieldEmpty, _
              Text:="StyleRef ""Heading " & figLvl & """ \s", _
              PreserveFormatting:=False)
              oNewFld.Update
              Set oRng = oNewFld.Code 'Added .Code but not sure what you need it for.
            End With '... to here
          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
    Greg

    Visit my website: http://gregmaxey.com

  3. #3
    You raised this in the original thread http://www.vbaexpress.com/forum/show...ht=#post384250 where I explained about moving the range to position the elements wherever you wish, and included a revised version of the code. The code you posted here bears little relationship to that code and as Greg has identified the .Range has become detached from what it is a range of - hence the error.
    Graham Mayor - MS MVP (Word)
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  4. #4
    VBAX Regular
    Joined
    Mar 2011
    Posts
    96
    Location
    Thank you Graham for the reminder. Yes, you did post the code and it works perfectly as you showed. If you forgive me, I will post it again as it will avoid having to look back at it.

    Here was your code:
    Sub ReplaceFieldsV6()
    '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, "Figure") > 0 Then
                    oFld.Code.Text = Replace(oFld.Code.Text, oFld.Code.Text, "SEQ Figure \* ARABIC \s \* MERGEFORMAT")
                    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
    The problem arises that the following line of code now has the wrong style and needs to be changed to reflect the main heading style it is sitting under, e.g. Heading 1 or Heading 2 and so on.
    Text:="""GA Numbered Heading 1""" & " \s",
    This change is being forced upon me as I'm quite happy to keep the existing one.

    This code identifies the necessary heading:

                    With Selection
                        Set figRng = .Range
                        Set figRng = figRng.GoTo(What:=wdGoToBookmark, Name:="\HeadingLevel")
                        figLvl = Right(figRng.Paragraphs.First.Style, 1)
                    End With
    Now the new line of code has to look like this:
    Text:="""Heading " & figLvl & """ \s"
    THIS is where the problem arises and I'm trying to figure out a way to accomplish this change.

    Again, I reiterate my "thank you" to you, Graham, for your help. I would not have changed the code if it had not been foisted on me to do so.

    Roderick

Posting Permissions

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