Consulting

Results 1 to 11 of 11

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

  1. #1
    VBAX Newbie
    Joined
    Dec 2020
    Posts
    1
    Location

    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

  2. #2
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    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

    Visit my website: http://gregmaxey.com

  3. #3
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    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
    Last edited by macropod; 01-06-2021 at 09:59 PM.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  4. #4
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    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
    Greg

    Visit my website: http://gregmaxey.com

  5. #5
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Quote Originally Posted by gmaxey View Post
    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
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  6. #6
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    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
    Greg

    Visit my website: http://gregmaxey.com

  7. #7
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    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...
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  8. #8
    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.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  9. #9
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    True, but occasionally there may be other content in the edited document that needs to be retained.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  10. #10
    Microsoft Word MVP 2003-2009 VBAX Guru gmaxey's Avatar
    Joined
    Sep 2005
    Posts
    3,334
    Location
    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.
    Greg

    Visit my website: http://gregmaxey.com

  11. #11
    Quote Originally Posted by gmaxey View Post
    it uncovered a glaring but has yet undiscovered hole in my fairly popular CC tools add-in. I will need to fix.
    Mine too
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

Tags for this Thread

Posting Permissions

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