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
Related
So, I am working with VBA on a word template which for every item (requirements in this case) contains a table with different specifications (all the tables are in the same format) and some other information. Below each table I have a text which shows the status of each item like: status: Approved or Work, or Rejected etc. I am asked to delete all the other statuses in the template and keep only the "Rejected" status and the whole information and table with that has this status to format in a light grey. Does anybody has any idea how to navigate to all tables, information, and specify the section I need to Format? I am very new to this and I am completely stucked! Here's some code I wrote:
Sub DeleteWorkflow()
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Normal")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Italic = False
With Selection.Find.Replacement.ParagraphFormat
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
End With
With Selection.Find
.Text = "Status: Approved"
.Text = "Status: Work"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute
'Finds status "Rejected" and changes the font color
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Status: Rejected"
.Forward = True
.Wrap = Word.WdFindWrap.wdFindContinue
.Font.ColorIndex = wdGray50
Selection.Find.Execute
End With
The code to find the rejected status and to change its color is not working and I am not getting it why. Any idea?
Basis of the idea
The idea is to look through the sentences of the word document. Sentences comprise regular text and also text contained within tables.
As you load all the sentences in a single object in VBA, you can look through the content of the document sentences by sentences and perform an action on it.
We can also apply that type of search to tables within the document, if the text they contain match the characters you want.
The code
For sentences
Sub SENTENCE_CHANGE_COLOR()
Dim i As Long
Dim oSentences As Sentences
'Here we instantiate the variable oSentences to store all the values of the current opened document
Set oSentences = ThisDocument.Sentences
' We loop through every fields of the document
For i = 1 To oSentences.Count
' The property .Text contains the text of the item in it
' Then we just have to look for the text within the string of characters
If InStr(oSentences.Item(i).Text, "Status: Rejected") Then
'Do some stuff, like changing the color
oSentences.Item(i).Font.ColorIndex = wdGray50
else
' Do some other things like changing the color to a different color
oSentences.Item(i).Font.ColorIndex = wdGray25
End If
Next i
End Sub
For tables
Sub TABLE_CHANGE_COLOR()
Dim i As Long
Dim oTables As Tables
'Here we instantiate the variable oTables to store all the tables of the current opened document
Set oTables = ThisDocument.Tables
' We loop through every fields of the document
For i = 1 To oTables.Count
' Finding the occurence of the text in the table
If Not InStr(oTables.Item(i).Range.Text, "Status: Rejected") = 0 Then
'Do some stuff, like changing the color
oTables.Item(i).Range.Font.ColorIndex = wdGray50
End If
Next i
End Sub
Combination of the above methods
After we found the occurrence of a "Status: Rejected" document we can select the table right before it by comparing the table's end to the start of the occurrence.
Beware since the following code would modify any table before "Status: rejected". So if "Status: rejected" is input in an incorrect location, it will modify the previous table wherever this table will be in the document.
Sub REJECTED_TABLE_CHANGE_COLOR()
Dim i As Long, j As Long
Dim oSentences As Sentences
Dim oTables As Tables
'Here we instantiate the variable oSentences to store all the values of the current opened document
Set oSentences = ThisDocument.Sentences
'Here we instantiate the variable oTables to store all the tables of the current opened document
Set oTables = ThisDocument.Tables
' We loop through every fields of the document
For i = 1 To oSentences.Count
' The property .Text contains the text of the item in it
' Then we just have to look for the text within the string of characters
If InStr(oSentences.Item(i).Text, "Status: Rejected") Then
' When we have found the correct text, we try to find the table just above it
' We start from the last table
' This condition ensures we do not start looking for before the first table
If oTables.Item(1).Range.End < oSentences.Item(i).Start Then
j = oTables.Count
While oTables.Item(j).Range.End > oSentences.Item(i).Start
j = j - 1
Wend
oTables.Item(j).Range.Font.ColorIndex = wdGray50
End If
End If
Next i
End Sub
This solution would provide you the basis to edit the document when the matching criteria is found within an item.
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.
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.
I am trying to write some code that will search through all the stories including headers, footers, footnotes etc and then stop at each occurrence so the user can make a decision about it (it may or may not change), then click a button again to move to the next occurrence (like Word's Find Next).
I am aware there is some pretty tricky code for performing a search and replace using the range object and I have that code working for another part of this project, but what I can't do is make it search and stop at the selected text, then carry on looking in the different stories, it just stops at the end of the main document.
The code below looks as though it should work but even if the footnote for example has the text to be searched for, it is ignoring it. I have done a thorough search of this site and others and have found several examples for search and replace, but none for search and stop/select.
Any advice gratefully received - thank you.
Sub TestSelection()
Dim rngStory As Range
Dim docDocument As Document
Set docDocument = ActiveDocument
With docDocument
For Each rngStory In .StoryRanges
Select Case rngStory.StoryType
Case 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11
Debug.Print rngStory.StoryType
With Selection.Find
.ClearFormatting
.Text = "XYZ"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
If Selection.Find.Found = True Then
Exit Sub
End If
End Select
Next rngStory
End With
End Sub
Whether this is your problem in this case I don't know, but while your loop iterates over all the ranges returned by StoryRanges, it does not process the entire document. It only includes the first part of each story. (So, for example, if there are several sections in your document, it will only include the header & footer from the first section).
You need to use the NextStoryRange method in order to access the entire story. Look that up in VBA help for an example loop construct. (It's a horrible API - just as bad as Range.Find!).
Also, be aware that executing a search will change the selection, so Selection.Find will suddenly be searching in the last result, rather than the entire range.
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