How to set Drop-Down List Content Control back to blank

[Max E]

I am working with Word 16, trying to eventually have a button or a macro I can run to reset all the fields in my document. At the moment I need to close word down without saving and then resize my window to get it in the right place in my workflow.

I have utilized the macro record function to reset some of my text boxes but I cant figure out how to reset my Drop-Down List Content Control back to its empty value.

I have spent the day trying to google how this is possible but either I don't know the right terms to search, am not able to decipher the answers or it isn't possible

If you have judged this correctly then yes I don't have very minimal experience in this field.

Thanks

[gmaxey]

Private Sub CC_Reset()
Dim oCC As ContentControl
Dim lngType As Long
For Each oCC In ActiveDocument.ContentControls
Select Case oCC.Type
'Richtext, Plaintext, Combobox, BuildingBlock, Date
Case 0, 1, 3, 5, 6: oCC.Range.Text = vbNullString
'Picture
Case 2
If oCC.Range.InlineShapes.Count = 1 Then oCC.Range.InlineShapes(1).Delete
'DropDownList
Case 3
lngType = oCC.Type
oCC.Type = 1
oCC.Range.Text = vbNullString
oCC.Type = lngType
'Checkbox
Case 8: oCC.Checked = False
'Repeating section
Case 9
For lngType = oCC.RepeatingSectionItems.Count To 2 Step -1
oCC.RepeatingSectionItems(lngType).Delete
Next lngType
If oCC.RepeatingSectionItems(1).Range.ContentControls.Count = 0 Then
oCC.RepeatingSectionItems(1).Range.Text = vbNullString
End If
End Select
Next oCC
lbl_Exit:
Exit Sub
End Sub

[macropod]

Greg: Your code has two instances of Case 3, but no Case 4. You also don't need the lngType variable.


Try:

Sub Demo()
Application.ScreenUpdating = False
Dim CCtrl As ContentControl
For Each CCtrl In ActiveDocument.ContentControls
With CCtrl
Select Case .Type
Case wdContentControlRichText, wdContentControlText, wdContentControlComboBox, wdContentControlBuildingBlockGallery, wdContentControlDate '0, 1, 3, 5, 6
.Range.Text = vbNullString
Case wdContentControlPicture '2
.Range.InlineShapes(1).Delete
Case wdContentControlDropdownList '4
.Type = wdContentControlText
.Range.Text = vbNullString
.Type = wdContentControlDropdownList
Case wdContentControlCheckBox '8
.Checked = False
Case wdContentControlRepeatingSection '9
With .RepeatingSectionItems
Do While .Count > 1
.Item(.Count).Delete
Loop
If .Count = 0 Then CCtrl.Range.Text = vbNullString
End With
End Select
End With
Next
Application.ScreenUpdating = True
End Sub

[gmaxey]

Paul,

You are right of course about the two 3s and no 4. At one point I believe I had 3 and 4 in the same Case statement the single three which should have been 4 :-(.

As for lngType, you are right about that too. However, looking closer at this and particularly the RSCCs, a viscous loop can be created if the CCs are locked for content or deletion. I've not groomed this very well but it resolves the issues I saw.




Sub Demo()
Application.ScreenUpdating = False
Dim oCC As ContentControl
Dim lngIndex As Long
Dim bUnlock As Boolean
On Error GoTo Err_Locked
For Each oCC In ActiveDocument.ContentControls
bUnlock = False
With oCC
Select Case .Type
Case wdContentControlRichText, wdContentControlText, wdContentControlComboBox, wdContentControlBuildingBlockGallery, wdContentControlDate '0, 1, 3, 5, 6
If bUnlock Then .LockContents = False
.Range.Text = vbNullString
If bUnlock Then .LockContents = True
Case wdContentControlPicture '2
If bUnlock Then .LockContents = False
.Range.InlineShapes(1).Delete
If bUnlock Then .LockContents = True
Case wdContentControlDropdownList '4
.Type = wdContentControlText
If bUnlock Then .LockContents = False
.Range.Text = vbNullString
If bUnlock Then .LockContents = True
.Type = wdContentControlDropdownList
Case wdContentControlCheckBox '8
If bUnlock Then .LockContents = False
.Checked = False
If bUnlock Then .LockContents = True
Case wdContentControlRepeatingSection '9
If .LockContents Then
If MsgBox("Processing encountered a repeating section content control locked for editing. Do you want " _
& "to reset the locked content control?", vbQuestion + vbYesNo, "LOCKED CONTENT") = vbYes Then
.LockContents = False
With .RepeatingSectionItems
Do While .Count > 1
For lngIndex = .Item(.Count).Range.ContentControls.Count To 1 Step -1
.Item(.Count).Range.ContentControls(lngIndex).LockContentControl = False
Next lngIndex
.Item(.Count).Delete
Loop
End With
.LockContents = True
End If
Else
With .RepeatingSectionItems
Do While .Count > 1
For lngIndex = .Item(.Count).Range.ContentControls.Count To 1 Step -1
.Item(.Count).Range.ContentControls(lngIndex).LockContentControl = False
Next lngIndex
.Item(.Count).Delete
Loop
End With
End If
End Select
End With
Next
lbl_Exit:
Application.ScreenUpdating = True
Exit Sub
Err_Locked:
If Err.Number = 6124 Then
If MsgBox("Processing encountered a content control locked for editing. Do you want " _
& "to reset the locked content control?", vbQuestion + vbYesNo, "LOCKED CONTENT") = vbYes Then
bUnlock = True
oCC.LockContents = False
Resume
Else
Resume Next
End If
Else
MsgBox Err.Number & " " & Err.Description
Resume lbl_Exit
End If
End Sub

[macropod]

looking closer at this and particularly the RSCCs, a viscous loop can be created if the CCs are locked for content or deletion.
As your revised code anticipates, any content control could be locked. Like your original code, mine wasn't too concerned about that. I'd approach the problem somewhat differently (untested):

Sub Demo()
Application.ScreenUpdating = False
Dim CCtrl As ContentControl, bState As Boolean
For Each CCtrl In ActiveDocument.ContentControls
With CCtrl
bState = .LockContents
If bState = True Then
Application.ScreenUpdating = True
.Range.Select
Application.ScreenUpdating = False
If MsgBox("This Content Control is Locked. Unlock?", vbYesNo) = vbYes Then
.LockContents = False
Select Case .Type
Case wdContentControlRichText, wdContentControlText, wdContentControlComboBox, wdContentControlBuildingBlockGallery, wdContentControlDate '0, 1, 3, 5, 6
.Range.Text = vbNullString
Case wdContentControlPicture '2
.Range.InlineShapes(1).Delete
Case wdContentControlDropdownList '4
.Type = wdContentControlText
.Range.Text = vbNullString
.Type = wdContentControlDropdownList
Case wdContentControlGroup '7
'Skip
Case wdContentControlCheckBox '8
.Checked = False
Case wdContentControlRepeatingSection '9
With .RepeatingSectionItems
Do While .Count > 1
With .Item(.Count)
With .Range.ContentControls
Do While .Count > 0
.Item(1).LockContentControl = False
.Item(1).Delete
Loop
End With
End With
Loop
If .Count = 0 Then CCtrl.Range.Text = vbNullString
End With
Case Else
End Select
End If
End If
.LockContents = bState
End With
Next
Application.ScreenUpdating = True
End Sub

[gmaxey]

Hi Paul,

Thanks for you interest in this process. It seems this is like chasing a greased pig and has become quite the hairball. First just ActiveDocument.ContentControls will skip all the other storyranges and then there is the richtext CCs that may have nested CCs and the goal may only be to clear them. Here is another stab that I think is getting closer to the polished cannonball:


Option Explicit
Sub Demo()
Dim colCCs As New Collection
Dim lngCC As Long
Dim oCC As ContentControl
Dim lngIndex As Long
Dim bUnlock As Boolean, bUARSections As Boolean
Set colCCs = fcnGetDocCCCollection(ActiveDocument)
Application.ScreenUpdating = False
On Error GoTo Err_Locked
For lngCC = colCCs.Count To 1 Step -1
Set oCC = ActiveDocument.ContentControls(colCCs.Item(lngCC))
bUnlock = False
With oCC
Select Case .Type
Case 0
If oCC.Range.ContentControls.Count = 0 Then
If bUnlock Then .LockContents = False
ResetRTCCRange oCC
If bUnlock Then .LockContents = True
Else
If .LockContents Then
If MsgBox("Processing encountered a content control locked for editing. Do you want " _
& "to reset the locked content control?", vbQuestion + vbYesNo, "LOCKED CONTENT") = vbYes Then
.LockContents = False
bUnlock = True
End If
End If
If Not .LockContents Then
If MsgBox("Processing encountered a rich text content control contain one or more nested content controls." & vbCr + vbCr _
& "With this condition the content control may contain content you wish to keep." & vbCr + vbCr _
& "Click ""Yes"" to reset only content nested in other controls." & vbCr + vbCr _
& "Click ""No"" to clear and reset all content?", vbQuestion + vbYesNo, "KEEP COTNENT") = vbYes Then
ResetRTCCRange oCC
Else
ResetRTCCRange oCC, True
End If
End If
If bUnlock Then .LockContents = True
End If
Case 1, 3, 5, 6
If bUnlock Then .LockContents = False
.Range.Text = vbNullString
If bUnlock Then .LockContents = True
Case 2
If bUnlock Then .LockContents = False
.Range.InlineShapes(1).Delete
If bUnlock Then .LockContents = True
Case 4
.Type = wdContentControlText
If bUnlock Then .LockContents = False
.Range.Text = vbNullString
If bUnlock Then .LockContents = True
.Type = wdContentControlDropdownList
Case 8
If bUnlock Then .LockContents = False
.Checked = False
If bUnlock Then .LockContents = True
Case 9
bUARSections = True
If Not .AllowInsertDeleteSection Then
If MsgBox("Processing encountered a repeating section content control locked from removing repeating sections. Do you want " _
& "to remove the repeating sections?", vbQuestion + vbYesNo, "LOCKED CONTENT") = vbYes Then
.AllowInsertDeleteSection = True
Else
bUARSections = False
End If
End If
If .LockContents Then
If MsgBox("Processing encountered a repeating section content control locked for editing. Do you want " _
& "to reset the locked content control?", vbQuestion + vbYesNo, "LOCKED CONTENT") = vbYes Then
.LockContents = False
With .RepeatingSectionItems
Do While .Count > 1
For lngIndex = .Item(.Count).Range.ContentControls.Count To 1 Step -1
.Item(.Count).Range.ContentControls(lngIndex).LockContentControl = False
Next lngIndex
If bUARSections Then .Item(.Count).Delete
Loop
End With
.LockContents = True
End If
Else
With .RepeatingSectionItems
Do While .Count > 1
For lngIndex = .Item(.Count).Range.ContentControls.Count To 1 Step -1
.Item(.Count).Range.ContentControls(lngIndex).LockContentControl = False
Next lngIndex
If bUARSections Then .Item(.Count).Delete
Loop
End With
End If
.AllowInsertDeleteSection = bUARSections
End Select
End With
Next
lbl_Exit:
Application.ScreenUpdating = True
Exit Sub
Err_Locked:
Select Case Err.Number
Case 6124
If MsgBox("Processing encountered a content control locked for editing. Do you want " _
& "to reset the locked content control?", vbQuestion + vbYesNo, "LOCKED CONTENT") = vbYes Then
bUnlock = True
oCC.LockContents = False
Resume
Else
Resume Next
End If
Case Else
MsgBox Err.Number & " " & Err.Description
Resume lbl_Exit
End Select
End Sub


Sub ResetRTCCRange(oCC As ContentControl, Optional bResetRTCC As Boolean = False)
Dim lngIndex As Long
On Error Resume Next
For lngIndex = oCC.Range.Tables.Count To 1 Step -1
oCC.Range.Tables(lngIndex).Delete
Next
If oCC.Range.ContentControls.Count = 0 Then oCC.Range.Text = vbNullString
For lngIndex = oCC.Range.ContentControls.Count To 1 Step -1
With oCC.Range.ContentControls(lngIndex)
.LockContentControl = False
.LockContents = False
.Range.Text = vbNullString
End With
Next lngIndex
On Error GoTo 0
If bResetRTCC Then oCC.Range.Text = vbNullString
lbl_Exit:
Exit Sub
End Sub


'***************************************For Working With Content Controls******************************************
Public Function fcnGetDocCCCollection(oDoc As Document) As Collection
Dim lngValidator As Long
Dim oStoryRng As Word.Range
Dim oCC As ContentControl
Dim oShp As Shape, oCanShp As Shape
Dim strSelectedID As String
Dim lngItems As Long
Dim oColCCs As Collection
Set oColCCs = New Collection
lngValidator = oDoc.Sections(1).Headers(1).Range.StoryType
For Each oStoryRng In oDoc.StoryRanges
'Iterate through all linked stories
Select Case oStoryRng.StoryType
Case 1 To 11
Do
On Error Resume Next
For Each oCC In oStoryRng.ContentControls
oColCCs.Add oCC.ID, oCC.ID
Next oCC
Select Case oStoryRng.StoryType
Case 6, 7, 8, 9, 10, 11
If oStoryRng.ShapeRange.Count > 0 Then
For Each oShp In oStoryRng.ShapeRange
On Error GoTo Err_HasText
If oShp.TextFrame.HasText Then
For Each oCC In oShp.TextFrame.TextRange.ContentControls
oColCCs.Add oCC.ID, oCC.ID
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
oColCCs.Add oCC.ID, oCC.ID
Next oCC
End If
Next oCanShp
End If
Err_HasText_ReEntry:
Next oShp
End If
Case Else
'Do Nothing
End Select
'Get next linked story (if any)
Set oStoryRng = oStoryRng.NextStoryRange
Loop Until oStoryRng Is Nothing
Case Else
End Select
Next oStoryRng
Set fcnGetDocCCCollection = oColCCs
Set oColCCs = Nothing
lbl_Exit:
Exit Function
Err_HasText:
Resume Err_HasText_ReEntry
End Function

[macropod]

Life's too short for cannon-ball polishing. Besides which, over-do it and the polish gets so thick they'll no longer go down the barrel...

[gmayor]

Wouldn't it be simpler just to save the document as a template and create new documents from it? If the CCs start with the placeholder texts showing, all new documents will have the placeholders showing regardless of what is entered in the documents.

[macropod]

True, but occasionally there may be other content in the edited document that needs to be retained.

[gmaxey]

Paul, Graham,

Yes and Yes. This has just been an exercise in thoroughness and it uncovered a glaring but has yet undiscovered hole in my fairly popular CC tools add-in. I will need to fix.

[gmayor]

it uncovered a glaring but has yet undiscovered hole in my fairly popular CC tools add-in. I will need to fix.Mine too :)