The contentcontrol "contents cannot be edited" checkbox is unchecked, and I use code to set
LockContets = False
, but even so, there is still error "You are not allowed to edit this selection because it is protected"
the code is as follow:
Sub Test()
Dim CC As ContentControl
For Each CC In ActiveDocument.ContentControls
Debug.Print CC.Type
Debug.Print CC.Range.Text
CC.LockContentControl = True
CC.LockContents = False
CC.Range.Text = "" <--error here
Next CC
End Sub
why will this happen? how to solve it?
You cannot clear the text from Dropdown List, CheckBox, or Picture Content Controls, since they don't have an editable text property.
Try something along the lines of:
Sub Test()
Dim CC As ContentControl
For Each CC In ActiveDocument.ContentControls
With CC
.LockContentControl = True
.LockContents = False
Select Case .Type
Case wdContentControlRichText, wdContentControlText, wdContentControlComboBox, wdContentControlDate
.Range.Text = ""
Case wdContentControlDropdownList
.Type = wdContentControlText
.Range.Text = ""
.Type = wdContentControlDropdownList
Case wdContentControlCheckBox: .Checked = False
Case wdContentControlPicture: .Range.InlineShapes(1).Delete
End Select
End With
Next CC
End Sub
There are many type of conent controls all you need is add an if condition to check if content coontrol type is of text
Sub Test()
Dim CC As ContentControl
For Each CC In ActiveDocument.ContentControls
CC.LockContents = False
If CC.Type = wdContentControlRichText Or CC.Type = wdContentControlText Then
CC.Range.Text = ""
End If
Next CC
End Sub
Related
I am trying to reference and paste a specified string into a specific Text Content Controls and have been unable to do this properly.
Basically I have gone through and tried a few different things, first being this;
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim ccs As ContentControls, cc As ContentControl
Set ccs = ActiveDocument.ContentControls
For Each cc In ccs
If cc.Title = "ComboBox1" And cc.Range.Text = "Choose an item." Then
SelectContentControlsByTitle("TextBox1").Add.SetPlaceholderText , , "Please make a drop down selection or manually fill out if not applicable"
The above does not work, as every time I exit my content controller combo box it actually recreates the "placeholdertext" multiple times. I need this to only fill the "TextBox1" Content control.
I have also tried doing something like this,
Dim ccs As ContentControls, cc As ContentControl
Set ccs = ActiveDocument.ContentControls
Set CB1 = SelectContentControlsByTitle("TextBox1")
For Each cc In ccs
If cc.Title = "ComboBox1" And cc.Range.Text = "Choose an item." Then
CB1.Value = "Please make a drop down selection or manually fill out if not applicable"
Due to the type, value is not able to be used like this. This does not work either.
Below is the original way I was doing what I wanted with the Active-X TextBox which does work;
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim ccs As ContentControls, cc As ContentControl
Set ccs = ActiveDocument.ContentControls
For Each cc In ccs
If cc.Title = "ComboBox2" And cc.Range.Text = "Choose an item." Then
TextBox2.Value = "Please make a drop down selection or manually fill out if not applicable"
ElseIf cc.Title = "ComboBox2" And cc.Range.Text = "TMS backup" Then
TextBox2.Value = "The TMS installation directory, settings directory and the database was backed up before the update was performed"
ElseIf cc.Title = "ComboBox2" And cc.Range.Text = "TMS installation" Then
TextBox2.Value = "Installation of version 1.17.X.19XXX performed"
ElseIf cc.Title = "ComboBox2" And cc.Range.Text = "TMS update" Then
TextBox2.Value = "Update from version 1.16.X.XXXXX to version 1.17.X.19XXX performed"
ElseIf cc.Title = "ComboBox2" And cc.Range.Text = "Tool presetter update" Then
TextBox2.Value = "Update from version 1.16.X.XXXXX to version 1.17.X.19XXX performed"
ElseIf cc.Title = "ComboBox2" And cc.Range.Text = "Database generated" Then
TextBox2.Value = "Database structure created with version 1.17.0"
How can I do the above, while using the Text Content Controls?
A better approach would be:
Private Sub Document_ContentControlOnExit(ByVal Ctrl As ContentControl, Cancel As Boolean)
Dim i As Long, StrDetails As String
With Ctrl
If .Title = "ComboBox1" Then
If ShowingPlaceholderText = True Then
StrDetails = ""
Else
For i = 1 To .DropdownListEntries.Count
If .DropdownListEntries(i).Text = .Range.Text Then
StrDetails = .DropdownListEntries(i).Value
Exit For
End If
Next
End If
ActiveDocument.SelectContentControlsByTitle("TextBox1")(1).Range.Text = StrDetails
End If
End With
End Sub
To make this work, simply add your 'conditional' text to each entry's 'Value' property, and make the "TextBox1" content control's placeholder text whatever you want its prompt to be. This way, you don't have to hard-code either the dropdown option or the 'conditional' text in your VBA code. For a practical demonstration, see: https://www.msofficeforums.com/word-vba/16498-multiple-entries-dropdown-lists.html#post46903
PS: You really should get away from the default ActiveX naming conventions and give your content controls meaningful titles.
Try this for setting the text box text:
Sub SetContentcontrolText()
Dim oRange As Range
Dim cc As ContentControl
For Each cc In ActiveDocument.ContentControls
If cc.Title = "ComboBox1" And cc.Range.Text = "Choose an item." Then
Set oRange = ActiveDocument.SelectContentControlsByTitle("TextBox1")(1).Range
oRange.Text = "Please make a drop down selection or manually fill out if not applicable"
End If
Next
End Sub
i am trying to write some code to clear a template. I have run into a problem when i try to clear a date picker. The code i have now does clear the datepicker, but it also removes the date picker function. Code is included below, thanks in advance!
Dim StopDate As ContentControl
Dim StartDate As ContentControl
With ActiveDocument.ContentControls(1)
.Type = wdContentControlText
.Range.Text = ""
.Type = wdContentControlDropdownList
End With
With ActiveDocument.ContentControls(2)
.Type = wdContentControlText
.Range.Text = ""
.Type = wdContentControlDropdownList
End With
Since you're working with Date content controls, you should use wdContentControlDate. For example:
With ActiveDocument
With .ContentControls(1)
.Type = wdContentControlText
.Range.Text = ""
.Type = wdContentControlDate
End With
With .ContentControls(2)
.Type = wdContentControlText
.Range.Text = ""
.Type = wdContentControlDate
End With
End With
I have an Initialization for a userform. It works fine when I initialize using the commented out part of the code, but when I use the code as shown below, I get a runtime error 91.
I need a way to loop through or select all textboxes to give them default value, color and etc...
Private Sub UserForm_Initialize()
Dim i As Long
Dim ctl As Control
For i = 1 To 4
ctl = "TextBox" & i
ctl.Value = ""
Next i
'TextBox1.Value = ""
'TextBox2.Value = ""
'TextBox3.Value = ""
'TextBox4.Value = ""
End Sub
In general, to refer to a TextBox of the form, you need Controls("TextboxN). If you want to loop, it is like this - Me.Controls("Textbox" & i), in case that you have not deleted any textboxes and they are following the default order
Thus, this is a possibility:
Private Sub UserForm_Initialize()
Dim i As Long
Dim ctl As Control
For i = 1 To 4
Me.Controls("Textbox" & i) = i
Me.Controls("Textbox" & i).BackColor = vbGreen
Next i
Debug.Print Me.TextBox3.Value
End Sub
With this screenshot, showing each TextBox getting a value of 1,2,3 or 4 and a green color:
Or even this, if you want to make the outlook of the controls a bit different:
Private Sub UserForm_Initialize()
Dim i As Long
Dim ctl As Control
For i = 1 To 4
With Me.Controls("Textbox" & i)
.Value = i
If i Mod 2 = 0 Then
.BackColor = vbBlue
.ForeColor = vbWhite
Else
.BackColor = vbGreen
.BackColor = vbRed
End If
End With
Next i
End Sub
If you are naming the textboxes, following your own programming logic, then looping through the collection of controls and checking the TypeName of the control is a better solution.
make a procedure in normal module:
Sub LoopTxBox()
Dim tb As MSForms.Control
For Each tb In UserForm1.Controls
If TypeName(tb) = "TextBox" Then 'capitalisation matters
'...
End If
Next tb
End Sub
and call it in UserForm_Initialize().
I am trying to use an Active-X Command button in Excel to select certain checkboxes and deselect others simultaneously. As it stands right now, I wish to uncheck all boxes that start with or contain the name "Design" while checking all those that start with or contain the name "Checkbox".
The code below was working for the unchecking of boxes that have "Design" in their name, but ever since I have added the checking of boxes starting with "Checkbox", I receive an error (Method "Name" of object'_OLEOBJECT' Failed).
Private Sub CommandButton1_Click()
Dim o As Object
For Each o In ActiveSheet.OLEObjects
If InStr(1, o.Name, "Design") > 0 Then
o.Object.Value = False
ElseIf InStr(1, o.Name, "CheckBox") < 1 Then
o.Object.Value = True
End If
Next
End Sub
I have also tried this variation which still results in the same error as the above:
Private Sub CommandButton1_Click()
Dim o As Object
For Each o In ActiveSheet.OLEObjects
If InStr(1, o.Name, "Design") > 0 Then
o.Object.Value = False
End If
Next
Dim j As Object
For Each j In ActiveSheet.OLEObjects
If InStr(1, j.Name, "CheckBox") < 1 Then
j.Object.Value = True
End If
Next
End Sub
Try this, it unchecks all checkboxes. Just set it to true if you want to check all checkboxes.
Sub uncheck_all()
Dim sh As Shape
Application.ScreenUpdating = False
For Each sh In ActiveSheet.Shapes
If sh.Type = msoOLEControlObject Then
If TypeName(sh.OLEFormat.Object.Object) = "CheckBox" Then sh.OLEFormat.Object.Object = True 'set to true if you want to check all checkboxes
End If
If sh.Type = msoFormControl Then
If sh.FormControlType = xlCheckBox Then sh.OLEFormat.Object = True 'set to true if you want to check all checkboxes
End If
Next sh
Dim o As Object
For Each o In ActiveSheet.OLEObjects
If o.Name Like "Design*" Then 'use If o.Name Like "*Design*" Then if you want to be any name with "Design" in the name.
o.Object.Value = False
End If
Next o
Application.ScreenUpdating = True
End Sub
I have the following code to customize the right click menu:
Sub CreateMenuItem()
Dim MenuButton As CommandBarButton
With CommandBars("Text") 'Text, Lists and Tables
Set MenuButton = .Controls.Add(msoControlButton)
With MenuButton
.Caption = "Correct"
.Style = msoButtonCaption
.OnAction = "InsertCorrect"
End With
End With
End Sub
It works fine with text and lists, but only partially with tables:
With CommandBars("Tables")
I must select the whole table or a column then it works but not inside a cell. What is the name for the context menu inside a cell or for text inside a table cell?
I made this routine to see al the names of the CommandBars in Word:
Sub ListYourCommandBars()
For Each c In CommandBars
Debug.Print c.Name
Next
End Sub
Good news they are already sorted alphabetically. I found one called Table Cells. I tried it:
With CommandBars("Table Cells")
and it worked. Only thing, a cell or a number of cells must be "wholly selected". That is, the menu-item doesnt show up if you just enter inside the cell, you must select the cell "as a whole" (dunno how to say it better). Hope this helps.
I got it to work inside a table cell by adding the MenuButton to the following Built-In CommandBars: "Text", "Linked Text", "Table Text", "Font Paragraph", "Linked Headings", "Linked Table", "Linked Text", "Lists", "Table Cells", "Table Lists", "Tables", "Tables and Borders", and "Text Box".
I’m not sure which one actually did the trick. Here’s my code:
Private DisableEvents As Boolean
Private Sub UpdateRightClickMenus()
Dim MenuButton As CommandBarButton
Dim CommandBarTypes(100) As String
Dim i As Long
Dim PRChecklistIsSelected As Boolean
Dim CheckListTypeFound As Boolean
PRChecklist = True
ResetRightClickMenus
CommandBarTypes(0) = "Text"
CommandBarTypes(1) = "Linked Text"
CommandBarTypes(2) = "Table Text"
CommandBarTypes(3) = "Font Paragraph"
CommandBarTypes(4) = "Linked Headings"
CommandBarTypes(5) = "Linked Table"
CommandBarTypes(6) = "Linked Text"
CommandBarTypes(7) = "Lists"
CommandBarTypes(8) = "Table Cells"
CommandBarTypes(9) = "Table Lists"
CommandBarTypes(10) = "Tables"
CommandBarTypes(11) = "Tables and Borders"
CommandBarTypes(12) = "Text Box"
Dim cc As ContentControl
Set cc = FindContentControlByTag("ListBox_PR_TR")
If IsNull(cc) Then
DisableEvents = False
Exit Sub
End If
'Find Selected
For i = 1 To cc.DropdownListEntries.Count
If cc.Range.Text = "Product Review" Then
PRChecklistIsSelected = True
CheckListTypeFound = True
Exit For
End If
If cc.Range.Text = "Technical Review" Then
PRChecklistIsSelected = False
CheckListTypeFound = True
Exit For
End If
Next i
If CheckListTypeFound = False Then Exit Sub
For i = 0 To 12
With Application
If PRChecklistIsSelected Then
'Add right-click menu option to set as a Product Review comment
With .CommandBars(CommandBarTypes(i))
Set MenuButton = .Controls.Add(msoControlButton)
With MenuButton
.Caption = "Set as Product Review Comment"
.Style = msoButtonCaption
.OnAction = "Set_as_Product_Review_Comment"
End With
End With
Else
'Add right-click menu option to set as a Tech Review comment
With .CommandBars(CommandBarTypes(i))
Set MenuButton = .Controls.Add(msoControlButton)
With MenuButton
.Caption = "Set as Tech Review Comment"
.Style = msoButtonCaption
.OnAction = "Set_as_Tech_Review_Comment"
End With
End With
End If
End With
Next i
RightClickMenuItemsAdded = True
End Sub
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
If DisableEvents = True Then Exit Sub
Set cc = FindContentControlByTag("ListBox_PR_TR")
If IsNull(cc) Then
ResetRightClickMenus
DisableEvents = False
Exit Sub
End If
If cc.Range.Text = "Technical Review" Then
Find_PR_Style_ReplaceWith_TR_Style
End If
UpdateRightClickMenus
DisableEvents = False
End Sub
Private Sub Find_PR_Style_ReplaceWith_TR_Style()
Set StylePR = ThisDocument.Styles("Product Review Style")
Set StyleTR = ThisDocument.Styles("Technical Review Style")
With ThisDocument.Content.Find
.ClearFormatting
.Style = StylePR
With .Replacement
.ClearFormatting
.Style = StyleTR
End With
.Execute Forward:=True, Replace:=wdReplaceAll, FindText:="", ReplaceWith:=""
End With
End Sub
Private Sub Set_as_Tech_Review_Comment()
Set StyleTR = ThisDocument.Styles("Technical Review Style")
With ThisDocument
Selection.Style = StyleTR
SetCanContinuePreviousList
End With
End Sub
Private Sub Set_as_Product_Review_Comment()
Set StylePR = ThisDocument.Styles("Product Review Style")
With ThisDocument
Selection.Style = StylePR
SetCanContinuePreviousList
End With
End Sub
Private Sub SetCanContinuePreviousList()
Dim lfTemp As ListFormat
Dim intContinue As Integer
Dim oldListNumber As Single
Set lfTemp = Selection.Range.ListFormat
oldListNumber = lfTemp.ListValue
If Not (lfTemp.ListTemplate Is Nothing) Then
intContinue = lfTemp.CanContinuePreviousList( _
ListTemplate:=lfTemp.ListTemplate)
lfTemp.ApplyListTemplate _
ListTemplate:=lfTemp.ListTemplate, _
ContinuePreviousList:=False, _
ApplyTo:=wdListApplyToWholeList
If lfTemp.ListValue = oldListNumber Then
lfTemp.ApplyListTemplate _
ListTemplate:=lfTemp.ListTemplate, _
ContinuePreviousList:=True, _
ApplyTo:=wdListApplyToWholeList
End If
End If
Set lfTemp = Nothing
End Sub
Private Function FindContentControlByTag(Tag As String) As ContentControl
For Each cc In ThisDocument.ContentControls
If cc.Tag = Tag Then
Set FindContentControlByTag = cc
Exit Function
End If
Next
End Function
Private Sub ResetRightClickMenus()
Dim CommandBarTypes(100) As String
Dim i As Long
CommandBarTypes(0) = "Text"
CommandBarTypes(1) = "Linked Text"
CommandBarTypes(2) = "Table Text"
CommandBarTypes(3) = "Font Paragraph"
CommandBarTypes(4) = "Linked Headings"
CommandBarTypes(5) = "Linked Table"
CommandBarTypes(6) = "Linked Text"
CommandBarTypes(7) = "Lists"
CommandBarTypes(8) = "Table Cells"
CommandBarTypes(9) = "Table Lists"
CommandBarTypes(10) = "Tables"
CommandBarTypes(11) = "Tables and Borders"
CommandBarTypes(12) = "Text Box"
For i = 0 To 12
Application.CommandBars(CommandBarTypes(i)).Reset
Next i
RightClickMenuItemsAdded = False
End Sub
Private Sub Document_Open()
UpdateRightClickMenus
End Sub
Private Sub Document_Close()
ResetRightClickMenus
End Sub