#1
|
|||
|
|||
VBA to clear all text boxes, not delete them
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 Code:
Selection.TypeText Text:=" " 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 |
#2
|
||||
|
||||
If you save the incomplete document as a template from which new documents are created, each new document would start with the text boxes cleared.
You would save a lot of trouble for the future if you replaced the text boxes, which appear to be graphical shapes, with rich text content controls and the dropdown lists with listbox content controls. These are both easier to work with and easier to extract data from. Insert Content Control Add-In will help with the change.
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
I have to agree with Graham regarding your choice of text boxes. But if there is some reason you must use what you have then perhaps:
Code:
Sub ScratchMacro() Dim oShp As Shape 'A basic Word Macro coded by Gregory K. Maxey On Error Resume Next For Each oShp In ActiveDocument.Shapes oShp.TextFrame.TextRange.Text = "" Next oShp lbl_Exit: Exit Sub End Sub |
#4
|
|||
|
|||
Quote:
|
#5
|
|||
|
|||
Quote:
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Word 2013 Text boxes on everything, can't select across multiple boxes | 1Kurgan1 | Word | 2 | 10-31-2016 01:20 AM |
Drawing lines between text boxes which have actual text within the text boxes | RHODIUM | Word | 6 | 10-01-2016 04:43 PM |
Text inside text boxes create headings inside my table of contents!!! How do I delete the created he | carstj | Word | 3 | 04-11-2016 12:46 PM |
please help, need formating a .doc with simple fillable text boxes and picture boxes | olson109 | Word | 5 | 03-12-2014 01:02 AM |
Word2010 check boxes and plain text content control boxes in same table | fcsungard | Word | 5 | 06-01-2012 01:16 AM |