Microsoft Office Forums - View Single Post - VBA to clear all text boxes, not delete them

Jrod9190 · 03-15-2023, 02:59 PM

Hello. I am finishing up a macro to clear my work center's checklists. The checklists have both dropdown boxes with predefined responses, and textboxes to write in information. My current script clears the dropdowns without issue, but the textbox portion of the code needs some work. It currently works, but I want to make it have longevity so it will continue to work after I leave here. The main concern is that my code has specifically names which textboxes to clear "Text Box 1, Text Box 2, etc". The main issue this creates is that if there are two text boxes with the same name "Text Box 1", only one will be cleared. Additionally, when new text boxes are made in the document, it does not automatically make the text box names sequential (I made 3 new textboxes, it named all 3 text box 2). I can easily go and update the text box names, however after I leave I'm 100% sure this will stop happening. As such, I'm hoping for a script that does the same exact thing as my code in regards to text boxes with the caveat that specific text boxes do not need to be specifically named. I was trying to get the code:

Code:

 ActiveDocument.Shapes.SelectAll

to work with the end of the current script that I have, but I can’t figure out how to make it work:

Code:

 Selection.TypeText Text:=" "

Any help would be appreciated, the code I made so far is below.

Code:

Sub Clear_Checklist()
Dim oCtl As Object
Dim oCC As ContentControl
On Error Resume Next
  For Each oCtl In ActiveDocument.InlineShapes
    If oCtl.OLEFormat.ProgID = "Forms.OptionButton.1" Then
oCtl.OLEFormat.Object.Value = False
oCtl.OLEFormat.Object.ForeColor = wdColorRed
End If
  Next oCtl
  For Each oCC In ActiveDocument.Range.ContentControls
    Select Case oCC.Type
      Case Is = wdContentControlDropdownList
        oCC.Type = 1
        oCC.Range.Text = vbNullString
        oCC.Type = wdContentControlDropdownList
         oCC.DropdownListEntries.Item(1).Select
      Case Else
        oCC.Range.Text = vbNullString
    End Select
  Next oCC
lbl_Exit:

  ' Clears Textboxes
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 1")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 2")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 3")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 4")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 5")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 6")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 7")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 8")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 9")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 10")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 11")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 12")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 13")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 14")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 15")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 16")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 17")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 18")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 19")).Select
 Selection.TypeText Text:=" "
On Error Resume Next
    ActiveDocument.Shapes.Range(Array("Text Box 20")).Select
 Selection.TypeText Text:=" "
   Exit Sub
End Sub