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
Related
I am trying to find a selection of text in a Word document and then lock the content control.
I have one search text 'Our Ref:' and another 'Your Ref:'.
When the second sub searches for 'Our Ref:' it also highlights 'Your Ref:'.
Screenshot of search result for 'our ref:'
I tried to add .MatchPrefix which works within the advanced find in Word, but not in the macro.
Is there a way to either skip the first result or narrow the search?
Private Sub LockOurRef()
With Selection.find
.Text = "Our Ref:"
.MatchWholeWord = True
.Forward = True
.Execute
Selection.Range.ContentControls.Add (wdContentControlGroup)
Selection.ParentContentControl.LockContentControl = True
End With
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.
This is my first time attempting VBA in Word although I've used it quite a bit in Excel. What I am trying to do is automatically execute my code after opening my Word template document. Here is the code I've placed in my Word template Module:
Private Sub AutoOpen()
Dim myValue
myValue = InputBox(prompt:="What is the client name", Title:="InputBox", Default:="Type your client name here")
stringReplaced = stringReplaced + "<Replace>"
For Each myStoryRange In ActiveDocument.StoryRanges
With myStoryRange.Find
.Text = "<Replace>"
.Replacement.Text = myValue
.Wrap = wdFindContinue
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Highlight = False
.Execute Replace:=wdReplaceAll
End With
Next myStoryRange
End Sub
I am using Word 2010. My code runs like I want it to when I manually go in and click run. However, when I close out of my Word document and reopen nothing happens at all. I've Googled the problem trying to find out a solution (and have attempt different versions of AutoOpen), but I can't figure out what I am doing wrong. Any ideas on why the AutoOpen doesn't execute automatically?
Thanks!
You should place your code in standard Module in your Template document. Next, change sub name from AutoOpen() into:
Sub AutoExec()
'..... your code here .....
End Sub
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 would like to delete certain lines from my word document using a VBA macro. Basically the (block of) text to be deleted (and replaced by "***") follows a certain pattern (below).
Bottom of Form
perma-link
Top of Form
save
Bottom of Form
[+] ....
[–] ....
Top of Form
"...." represents text that changes every block, but for sure the line starts with "[+]" or "[-]".
Please suggest a suitable macro
EDIT: In the screenshot, I would like to keep the text in yellow and delete the rest. (in the actual file, the text isn't in yellow)
PS-FYI, I tried using the example looping a find and delete row macro (for line by line deletion) but i get a runtime error 5941 with debugging option highlighting the line "selection.row.delete" in the macro.
What does this mean?
Assuming that the example list is a list of paragraphs beginnings the following code should do the trick. What you have to do is to place all 'paragraphs starting' into array arrRemove as I did for the test. If any of the mark is a special marks (see this link for additional information) you need to add \ in front of it as I did for [+] and [-]. Hope this is what you are looking for.
Sub Macro2()
Dim arrRemove As Variant
arrRemove = Array("Bottom of Form", "perma -link", "Top of Form", _
"\[+\]", "\[\-\]", "Donec", "In")
Dim i!
For i = 0 To UBound(arrRemove)
Activedocument.Range(0,0).select
Selection.Find.ClearFormatting
With Selection.Find
.Text = arrRemove(i) & "*^13"
.Replacement.Text = "" 'replace with nothing
.Forward = True
.Wrap = wdFindContinue
.MatchCase = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next i
End Sub
The above macro will remove all yellow paragraph in the following document.