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

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

Code:

---

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

---

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


Try:

Code:

---

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

---

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.

Code:

---

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

---

Quote:

---

Originally Posted by gmaxey

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

Code:

---

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

---

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:

Code:

---

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

---

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...

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.

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

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.

Quote:

---

Originally Posted by gmaxey

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

---

Mine too :)