How to lock/unlock ContentControls in ALL Footers

[Andreas.Vogt]

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:

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



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

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:


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

[gmaxey]

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

[Andreas.Vogt]

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

[gmaxey]

No idea. That doesn't happen here.

[Andreas.Vogt]

No idea. That doesn't happen here.

It happens here:



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

[gmaxey]

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.

[gmayor]

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


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

[Andreas.Vogt]

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


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

oCC.LockContentControl = bState
trough:


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


because:


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:


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

[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

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

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

[Andreas.Vogt]

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

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

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:

oCC.LockContentControl = bState
brings an error:
Error while compiling:
Method or Dataobject not found

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

Selection.Range.ContentControls.Add (wdContentControlGroup)
without "select"?

Thanks a lot for your help!!

best regards,
Andreas

[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:


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

[Andreas.Vogt]

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:


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

oFld.Code.Select
by

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

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:


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