My current project is making a list for a coworker and since I like to over-complicate everything, I'm running macros for him to check off as he completes work. The description of work will change from a header style to normal when he's completed it, then update the ToC. All of this is working, but I have trouble with the content control staying selected sometimes. I can usually check and uncheck it once or twice with no problem, but eventually the cursor doesn't move out of the check box for some reason so subsequent clicks don't fire the OnEnter.
Private Sub Document_ContentControlOnEnter(ByVal CCtrl As ContentControl)
With CCtrl
If .Type = wdContentControlCheckBox Then
If .Checked = True Then
.Range.Paragraphs.First.Style = wdStyleNormal
ActiveDocument.TablesOfContents(1).Update
Selection.Collapse direction:=wdCollapseEnd
Else
.Range.Paragraphs.First.Style = wdStyleHeading2
ActiveDocument.TablesOfContents(1).Update
Selection.MoveRight 1
End If
End If
End With
End Sub
Is there a way to force word to deselect the content control and move the cursor somewhere on the same line?
I tried Selection.MoveDown 1, Selection.Collapse direction:=wdCollapseEnd, and also Selection.MoveEnd but none work.
You can leverage the fact that, through the Content Control's Range the objects which contain it can be accessed. For example, you can "drill up" to the paragraph in which the content control is located:
CCtrl.Range.Paragraphs(1).Range.Characters.Last.Select
This could also be any character in the paragraph. The following (in my test) puts the selection immediately after the content control:
CCtrl.Range.Paragraphs(1).Range.Characters(4).Select
Incorporated into your code:
Private Sub Document_ContentControlOnEnter(ByVal CCtrl As ContentControl)
With CCtrl
If .Type = wdContentControlCheckBox Then
If .Checked = True Then
.Range.Paragraphs.First.Style = wdStyleNormal
ActiveDocument.TablesOfContents(1).Update
Selection.Collapse direction:=wdCollapseEnd
Else
.Range.Paragraphs.First.Style = wdStyleHeading2
ActiveDocument.TablesOfContents(1).Update
Selection.MoveRight 1
End If
'Select the last character in the paragraph (the paragraph mark)
CCtrl.Range.Paragraphs(1).Range.Characters.Last.Select
'Remove the selection, so the cursor blinks at the end of the paragraph
Selection.Collapse
End If
End With
End Sub
Related
I have a userform with a bunch of checkboxes. I want the VBA code to add a block of text (defined as a variable) if the checkbox is true and remove that block of text if it gets unchecked. As an example, this is what I have for one of the checkboxes:
Private Sub CheckBox1_Click()
Dim Text1 As String
Text1 = "Text test"
If CheckBox1.Value = True Then
Selection.TypeText Text:=Text1
Selection.InsertParagraph
End If
If CheckBox1.Value = False Then
Selection.Delete Text:=Text1
End If
End Sub
First of all, the Selection.Delete Text:=Text1 part is completely wrong. I've tried to google something similar and have been unable to find anything that deletes the content of a variable.
Second of all, there seems to be an error with the Selection.InsertParagraph code. I want it to add a new paragraph between each block of text/variable, however with the way that the code is now, it adds the text block and the paragraphs separately like this if I were to activate the macro 3 times:
Text testText testText test
(new paragraph)
(new paragraph)
(new paragraph)
What I want instead is this:
Text test
(new paragraph)
Text test
(new paragraph)
Text test
(new paragraph)
Answering the first question, for which there is sufficient information to provide an answer...
The best control of where something is inserted and foramtted in a Word document is to use Range objects. There can be only one Selection, but code can work with multiple Ranges.
For inserting a new paragraph immediately following text it's possible to append the new paragraph at the end of the text using the ANSI 13 character, which can be represented in VBA code using vbCr.
Example:
Private Sub CheckBox1_Click()
Dim Text1 As String
Dim rngTarget as Range
Text1 = "Text test"
Set rngTarget = Selection.Range
If CheckBox1.Value = True Then
rngTarget.Text = Text1 & vbCr
End If
'
'If CheckBox1.Value = False Then
' Selection.Delete Text:=Text1
'End If
'''Move to the end of the range and select that for the next iteration
rngTarget.Collapse wdCollapseEnd
rngTarget.Select
End Sub
I am trying to create a button that copies the contents of an entire page, and pastes it to a new page within the same document. When I first formatted this as a MacroButton (CTRL + F9) it would work multiple times. Now I have tried it using a command button under Legacy forms (Developer tab) as a click event, and it will only work once. I am not sure why this is occuring. Here is my code:
Private Sub AddPage3_Click()
Const wdPageBreak = 7
ActiveDocument.Bookmarks("\page").Range.Copy
Selection.InsertBreak (wdPageBreak)
Selection.Paste
Selection.TypeBackspace
Selection.TypeBackspace
End Sub
When I press the button, it will create another page in the document with the contents of the active page (the page the button is located on), but it will not work a second time. If you have any suggestions please let me know :)!
After copy/paste, you can rename your commandbutton as follows and the commandbutton keeps running each time:
Private Sub AddPage3_Click()
Dim shp As InlineShape
Const wdPageBreak = 7
ActiveDocument.Bookmarks("\page").Range.Copy
Selection.InsertBreak (wdPageBreak)
Selection.Paste
Selection.TypeBackspace
Selection.TypeBackspace
For Each shp In ActiveDocument.InlineShapes
On Error Resume Next
If shp.OLEFormat.ClassType = "Forms.CommandButton.1" Then
If shp.OLEFormat.Object.Name = "AddPage31" Then
shp.OLEFormat.Object.Name = "AddPage3"
End If
End If
Next
End Sub
I have created a userform with a multiselect listbox with an "OK" command. When my user makes selections from the listbox and clicks the OK command, I want to create an array (based on the user's selections in the listbox) that I can then loop over for each item in the array as I open multiple files the user has specified.
For example, if my user selects "Client 1" and "Client 3" in my listbox and then selects the "OK" command, I want to create an array from those values and then call up each value in the array in a "find and replace" Sub that replaces, e.g., "Client 1" with "Client 1" (colored red), "Client 3" with "Client 3" (colored red). (The red is so that my other find and replace macro can skip these items by specifying a different color to find for, along with text Client 1, Client 3, etc.)
Reading elsewhere on this site, I created a function to try to generate the array, but I don't know how to get it into and use it in my UserForm Sub.
After finding an answer, below, I deleted the original code I had pasted here, because it was clearly all wrong and won't help anyone.
Additional information about the overall objective: I have already created a macro to do an initial find and replace in multiple files. This macro opens a bunch of files selected by the user and replaces certain client names with the text "Confidential Client". Now, people are asking me if they can exclude certain clients from being replaced. That is why I want to add the userform with a listbox that will let them select clients to exclude.
Please help!
So, through much trial and error and googling, I came up with the following solution, which works well for my purpose. First, after clicking F7 on my userform, I added the items to a list array.
Private Sub UserForm_Initialize()
'Creates and assigns the array to ListBoxClients when the form loads
With ListBoxClients
.AddItem "Client 1"
.AddItem "Client 2"
.AddItem "Client 3"
End With
End Sub
Then, I created the following response to my "OK" command. First, it prompts the user to select the files to process and opens the first file:
Private Sub cmdOK_Click()
Me.Hide
MsgBox "Click OK to browse and select files to exclude.", vbInformation
Dim MyDialog As FileDialog, GetStr(1 To 3000) As String '3000 files is the maximum applying this code
On Error Resume Next
Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
With MyDialog
.Filters.Clear
.Filters.Add "All WORD File ", "*.docx", 1
.AllowMultiSelect = True
i = 1
If .Show = -1 Then
For Each stiSelectedItem In .SelectedItems
GetStr(i) = stiSelectedItem
i = i + 1
Next
i = i - 1
End If
Application.ScreenUpdating = False
For j = 1 To i Step 1
Set Doc = Documents.Open(FileName:=GetStr(j), Visible:=True)
Windows(GetStr(j)).Activate
Then, I loop through the selected items in the array and replace each selected item with the same text, colored red (so my other macro--not shown here--will skip over it when it performs the find and replace):
'Find and replace listbox items in files
Dim ii As Integer
For ii = 0 To ListBoxClients.ListCount - 1
If ListBoxClients.Selected(ii) Then
Selection.Text = ListBoxClients.List(ii)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Color = 192
With Selection.Find
.Text = Selection.Text
.Replacement.Text = Selection.Text
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Before I finish, I get rid of the selected array item that for reasons unknown is pasted at the top of each of my files:
' delete mysterious added text at top of page (figure this out later)
Selection.HomeKey Unit:=wdStory
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
End If
Next ii
Then I have some code that closes the current document and returns it to the top section of the sub to open the next file (and eventually end). I have no idea why "Application.Run macroname:="NEWMACROS" is there, but it works, so I'm not going to delete it.
Application.Run macroname:="NEWMACROS"
ActiveDocument.Save
ActiveWindow.Close
Next
Application.ScreenUpdating = True
End With
End Sub
Finally, I add the code to cancel the form if the user changes his/her mind:
Private Sub cmdCancel_Click()
'User has cancelled so hide the form
Me.Hide
End Sub
That's it. I hope this helps someone else.
The below code display Find and Replace dialog box. But the problem is that the Find tab and the Go To tabs are disabled.
How to keep all the three tabs enabled?
Is it possible to set the Find and Replace combobox Editable property to False?
Public Sub EditReplace()
On Error Resume Next
With Dialogs(wdDialogEditReplace)
Selection.HomeKey Unit:=wdStory
.Find = "[ ^13^t]{1,};"
.Replace = ";"
.Show
End With
End Sub
Try (with the assumption that "Ctrl H" is still a shortcut for "Replace" in the menu):
Public Sub AnotherName()
On Error Resume Next
Selection.HomeKey Unit:=wdStory
Selection.Find.Text = "[ ^13^t]{1,};"
Selection.Find.Replacement.Text = ";"
SendKeys "+^%H", True
End Sub
The name should rather not be "EditReplace", or you will direct here all replace operations in the future.
I'm trying to write a macro that displays a popup when a user clicks save (I have it as Sub FileSave() ) if the document contains any highlighting. So far, everything works great with the message box. Unfortunately I can't figure out which conditions to use for the if statement to check whether the document contains highlighting or not.
Can anyone help me with a few lines of VBA for this?
You simply need to search for highlighted text within document content in this way:
Sub SearchAnyHighlight()
Dim hiliRng As Range
Set hiliRng = ActiveDocument.Content
With hiliRng.Find
.Highlight = True
.Execute
End With
If hiliRng.Find.Found Then
'to inform that something was found
MsgBox "You can't close Active Document"
'to remove all highlighted area <-- added after edition
With hiliRng.Find
.Replacement.Highlight = False
.Execute "", Replace:=wdReplaceAll, Forward:=True, _
ReplaceWith:="", Format:=True
End With
End If
End Sub