How to lock/unlock ContentControls in ALL Footers

Hello,

i would like to have 2 functions to lock and unlock Contentcontrols in all Footers in my Word Document.
The syntax to group and lock is:

Code:

---

Selection.Range.ContentControls.Add (wdContentControlGroup)
Selection.ParentContentControl.LockContentControl = True

---

I have written this, but I have a problem with footers on different pages:

Code:

---

Application.ScreenUpdating = False
Dim Sctn As Section, HdFt As HeaderFooter
With ActiveDocument
  For Each Sctn In .Sections
    MsgBox (Sctn.Index)
    For Each HdFt In Sctn.Headers
      With HdFt
        If .LinkToPrevious = False Then
          With .Range
            ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader
            For Each fieldX In .Fields
              If InStr(1, fieldX.Code.Text, "KLASSIFIZIERUNG", 1) > 0 Then
                  fieldX.Select
                  Selection.Range.ContentControls.Add (wdContentControlGroup)
                  Selection.ParentContentControl.LockContentControl = True
              End If
            Next fieldX
          End With
        End If
      End With
    Next
    For Each HdFt In Sctn.Footers
      With HdFt
        If .LinkToPrevious = False Then
          With .Range
          ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
            For Each fieldX In .Fields
              If InStr(1, fieldX.Code.Text, "KLASSIFIZIERUNG", 1) > 0 Then
                  fieldX.Select
                  Selection.Range.ContentControls.Add (wdContentControlGroup)
                  Selection.ParentContentControl.LockContentControl = True
              End If
            Next fieldX
          End With
        End If
      End With
    Next
  Next
End With

---

Also another approach did not work:

Code:

---

Dim oHFKL As HeaderFooter
Dim fieldX As Field
ActiveWindow.ActivePane.View.SeekView = wdSeekFirstPageFooter
    For Each fieldX In ActiveDocument.Sections(0).Footers(wdHeaderFooterFirstPage).Range.Fields
        If InStr(1, fieldX.Code.Text, "KLASSIFIZIERUNG", 1) > 0 Then
            fieldX.Select
            Selection.Range.ContentControls.Add (wdContentControlGroup)
            Selection.ParentContentControl.LockContentControl = True
        End If
    Next fieldX

---

as I do not know if I have to use wdHeaderFooterFirstPage or wdHeaderFooterPrimaryPage in the section 0,1,2,..and so on..

I also get a display problem (ActiveWindow.ActivePane.View.Type switches to 1 and does not remain in status 3) when using this function above.
The fields in my footers are VBA Docvariables with "KLASSIFIZIERUNG" (engl: classification) within, so thats why I check the field.Code.Text by Instr()

Any help? Any ideas?

best regards,
Andreas

Code:

---

Sub LockCC()
  SetCCStateInFooters True
lbl_Exit:
  Exit Sub
End Sub
Sub UnlockCC()
  SetCCStateInFooters False
lbl_Exit:
  Exit Sub
End Sub

Public Sub SetCCStateInFooters(bState As Boolean)
Dim rngStory As Word.Range
Dim lngJunk As Long
Dim oShp As Shape, oCanShp As Shape
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
Dim oCC As ContentControl
  For Each rngStory In ActiveDocument.StoryRanges
    'Iterate through all linked stories
    Do
      On Error Resume Next
      Select Case rngStory.StoryType
        Case 8, 9, 11
          For Each oCC In rngStory.ContentControls
            oCC.LockContentControl = bState
          Next oCC
          If rngStory.ShapeRange.Count > 0 Then
            For Each oShp In rngStory.ShapeRange
              If oShp.TextFrame.HasText Then
                For Each oCC In oShp.TextFrame.TextRange.ContentControls
                  oCC.LockContentControl = bState
                Next oCC
              End If
              If oShp.Type = msoCanvas Then
                For Each oCanShp In oShp.CanvasItems
                  If oCanShp.TextFrame.HasText Then
                    For Each oCC In oCanShp.TextFrame.TextRange.ContentControls
                      oCC.LockContentControl = bState
                    Next oCC
                  End If
                Next oCanShp
              End If
            Next
          End If
        Case Else
          'Do Nothing
      End Select
      On Error GoTo 0
      'Get next linked story (if any)
      Set rngStory = rngStory.NextStoryRange
    Loop Until rngStory Is Nothing
  Next
lbl_Exit:
  Exit Sub
End Sub

---

Quote:

---

Originally Posted by gmaxey

Code:

---

Sub LockCC()
  SetCCStateInFooters True
lbl_Exit:
  Exit Sub
End Sub
Sub UnlockCC()
  SetCCStateInFooters False
lbl_Exit:
  Exit Sub
End Sub

Public Sub SetCCStateInFooters(bState As Boolean)
Dim rngStory As Word.Range
Dim lngJunk As Long
Dim oShp As Shape, oCanShp As Shape
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
Dim oCC As ContentControl
  For Each rngStory In ActiveDocument.StoryRanges
    'Iterate through all linked stories
    Do
      On Error Resume Next
      Select Case rngStory.StoryType
        Case 8, 9, 11
          For Each oCC In rngStory.ContentControls
            oCC.LockContentControl = bState
          Next oCC
          If rngStory.ShapeRange.Count > 0 Then
            For Each oShp In rngStory.ShapeRange
              If oShp.TextFrame.HasText Then
                For Each oCC In oShp.TextFrame.TextRange.ContentControls
                  oCC.LockContentControl = bState
                Next oCC
              End If
              If oShp.Type = msoCanvas Then
                For Each oCanShp In oShp.CanvasItems
                  If oCanShp.TextFrame.HasText Then
                    For Each oCC In oCanShp.TextFrame.TextRange.ContentControls
                      oCC.LockContentControl = bState
                    Next oCC
                  End If
                Next oCanShp
              End If
            Next
          End If
        Case Else
          'Do Nothing
      End Select
      On Error GoTo 0
      'Get next linked story (if any)
      Set rngStory = rngStory.NextStoryRange
    Loop Until rngStory Is Nothing
  Next
lbl_Exit:
  Exit Sub
End Sub

---

---

Hi,
the code works fine, but If I am in the printView View the code changes to Draftview during execution and back to printView afterwards. How can I prevent this?

best regards,

Andreas

No idea. That doesn't happen here.

Quote:

---

Originally Posted by gmaxey

No idea. That doesn't happen here.

---

It happens here:

Code:

---

Case 8, 9, 11          For Each oCC In rngStory.ContentControls
            oCC.LockContentControl = bState
          Next oCC

---

The Screen switches from Printview to a splitted Screen (top=document, bottom=footer)
?
After executing the sub, it switches back.
Can I prevent word from showing this screen?
best regards and thanks a lot for your help!!
Andreas

There is nothing in the code that should trigger that. Typically that only happens of you physically select the object in the footer. That isn't happening in the code.

It doesn't happen here either, but I suppose you could force the Normal view?

Code:

---

Sub LockCC()
    SetCCStateInFooters True
    If ActiveWindow.View.SplitSpecial = wdPaneNone Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    Else
        ActiveWindow.View.Type = wdPrintView
    End If
lbl_Exit:
    Exit Sub
End Sub


Sub UnlockCC()
    SetCCStateInFooters False
    If ActiveWindow.View.SplitSpecial = wdPaneNone Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    Else
        ActiveWindow.View.Type = wdPrintView
    End If
lbl_Exit:
    Exit Sub
End Sub

---

Quote:

---

Originally Posted by gmayor

It doesn't happen here either, but I suppose you could force the Normal view?

Code:

---

Sub LockCC()
    SetCCStateInFooters True
    If ActiveWindow.View.SplitSpecial = wdPaneNone Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    Else
        ActiveWindow.View.Type = wdPrintView
    End If
lbl_Exit:
    Exit Sub
End Sub


Sub UnlockCC()
    SetCCStateInFooters False
    If ActiveWindow.View.SplitSpecial = wdPaneNone Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    Else
        ActiveWindow.View.Type = wdPrintView
    End If
lbl_Exit:
    Exit Sub
End Sub

---

---

Hi,
well, that may be the solution..
I replaced

Code:

---

oCC.LockContentControl = bState

---

trough:

Code:

---

oCC.Select
Selection.Range.ContentControls.Add (wdContentControlGroup)
Selection.ParentContentControl.LockContentControl = bState

---

because:

Code:

---

oCC.LockContentControl = bState
oCC.ParentContentControl.LockContentControl = bState
oCC.ContentControls.Add (wdContentControlGroup)

---

does not work (method or dataobject not found)

Furthermore, I would like to set the language Setting for the whole document, even the footers, so I added:

Code:

---

ActiveDocument.ActiveWindow.Selection.WholeStoryActiveDocument.ActiveWindow.Selection.LanguageID = wdgerman
ActiveDocument.ActiveWindow.Selection.NoProofing = True
Application.CheckLanguage = False

---

Is there a more graceful way to do that?

best regards,
Andreas

You don't need to select controls or story ranges in order to process them. Selecting items in the footer will open the footer, hence the problem you had.
You need to use instead ranges.
You can process the document range instead

Code:

---

With ActiveDocument.Range
        .LanguageID = wdGerman
        .NoProofing = True
End With

---

Greg's code creates ranges for the headers and footers so you can process those ranges also

Code:

---

Select Case rngStory.StoryType    Case 8, 9, 11
        With rngStory
            .LanguageID = wdGerman
            .NoProofing = True
        End With
        For Each oCC In rngStory.ContentControls
            oCC.LockContentControl = bState
        Next oCC

---

Quote:

---

Originally Posted by gmayor

You don't need to select controls or story ranges in order to process them. Selecting items in the footer will open the footer, hence the problem you had.
You need to use instead ranges.
You can process the document range instead

Code:

---

With ActiveDocument.Range
        .LanguageID = wdGerman
        .NoProofing = True
End With

---

Greg's code creates ranges for the headers and footers so you can process those ranges also

Code:

---

Select Case rngStory.StoryType    Case 8, 9, 11
        With rngStory
            .LanguageID = wdGerman
            .NoProofing = True
        End With
        For Each oCC In rngStory.ContentControls
            oCC.LockContentControl = bState
        Next oCC

---

---

Hello,
thanks for your response. It works almost perfect I guess, BUT:

Code:

---

oCC.LockContentControl = bState

---

brings an error:
Error while compiling:
Method or Dataobject not found

And how may I group the oCC, I was using:

Code:

---

Selection.Range.ContentControls.Add (wdContentControlGroup)

---

without "select"?

Thanks a lot for your help!!

best regards,
Andreas

In my first post, I answered your posted question. How to lock/unlock CCs in the document footers.

To wrap a field located in the footers in a group control, it appears that you must select the content:

Code:

---

Public Sub SetGroupCCInFooters()
Dim rngStory As Word.Range
Dim lngJunk As Long
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
Dim oCC As ContentControl
Dim oFld As Field
Dim oFtr As HeaderFooter
Dim lngView As Long
  lngView = ActiveDocument.ActiveWindow.View
  For Each rngStory In ActiveDocument.StoryRanges
    'Iterate through all linked stories
    Do
      On Error Resume Next
      Select Case rngStory.StoryType
        Case 8, 9, 11
          For Each oFld In rngStory.Fields
            If InStr(oFld.Code, "Classified") > 0 Then
              oFld.Code.Select
              Set oCC = Selection.ContentControls.Add(wdContentControlGroup, oFld.Code)
              oCC.LockContentControl = True
            End If
          Next oFld
        Case Else
          'Do Nothing
      End Select
      On Error GoTo 0
      'Get next linked story (if any)
      Set rngStory = rngStory.NextStoryRange
    Loop Until rngStory Is Nothing
  Next
  ActiveDocument.ActiveWindow.View = lngView
lbl_Exit:
  Exit Sub
End Sub

---

Quote:

---

Originally Posted by gmaxey

In my first post, I answered your posted question. How to lock/unlock CCs in the document footers.

To wrap a field located in the footers in a group control, it appears that you must select the content:

Code:

---

Public Sub SetGroupCCInFooters()
Dim rngStory As Word.Range
Dim lngJunk As Long
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
Dim oCC As ContentControl
Dim oFld As Field
Dim oFtr As HeaderFooter
Dim lngView As Long
  lngView = ActiveDocument.ActiveWindow.View
  For Each rngStory In ActiveDocument.StoryRanges
    'Iterate through all linked stories
    Do
      On Error Resume Next
      Select Case rngStory.StoryType
        Case 8, 9, 11
          For Each oFld In rngStory.Fields
            If InStr(oFld.Code, "Classified") > 0 Then
              oFld.Code.Select
              Set oCC = Selection.ContentControls.Add(wdContentControlGroup, oFld.Code)
              oCC.LockContentControl = True
            End If
          Next oFld
        Case Else
          'Do Nothing
      End Select
      On Error GoTo 0
      'Get next linked story (if any)
      Set rngStory = rngStory.NextStoryRange
    Loop Until rngStory Is Nothing
  Next
  ActiveDocument.ActiveWindow.View = lngView
lbl_Exit:
  Exit Sub
End Sub

---

---

Hi, well I replaced

Code:

---

oFld.Code.Select

---

by

Code:

---

oFld.Select

---

But I still get an error "Method or Dataobject not found" here:

Code:

---

oCC.LockContentControl = True

---

I just want to Lock and group the Fields with the String "Klassifizierung" in its .code.text and lock this fields.

I tried:

Code:

---

If bState = True Then oCC.Select
 Selection.Range.ContentControls.Add (wdContentControlGroup)
 Selection.ParentContentControl.LockContentControl = bState
 Selection.Collapse
Else
 oCC.Select
 Selection.ParentContentControl.LockContentControl = bState
 Selection.Range.ParentContentControl.Ungroup
 Selection.Collapse
End If

---

but this does not work either... Still getting the view problem.
is there a chance to select something, but not switching the paneview to splitview?

best regards,
Andreas