I have a document that has a bunch of projects. I've gone through and certain projects are in red font if they are high priority.
I want to make a macro so that Word finds all instances of red font, saves those project names, and then pastes them in a list at the top of my document.
When I tried to do the Macro Recorder, this is what I got.
Sub HotTopics()
'
' HotTopics Macro
'
'
Selection.Find.ClearFormatting
Selection.Find.Font.Color = wdColorRed
With Selection.Find
.Text = ""
.Font.Color = wdColorRed
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Copy
Selection.PasteAndFormat (wdFormatOriginalFormatting)
End Sub
When I try running the macro, it says there is an error with Selection.copy because there is nothing to copy
You didn't click Find while recording the macro. Note second last line.
Selection.Find.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchByte = False
.CorrectHangulEndings = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute
Selection.Copy
Related
I want to get and select the result of a find and replacement macro and do some operations on it.
Say, this is the text: \[abc\], I want to convert it to abc and then select abc.
Here is the code:
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "(\\\[)(*)(\\\])"
.Replacement.Text = "\2"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Cut
Here in the last line, Selection.Cut gives an error that the Selection is empty.
I want to select the output of the replacement and Cut it.
From my repository Amin MSWord VBA macros
wdReplaceAll as the Replacement "target" doesn't jump to individual "hits", which is why the Selection is not picking up anything.
Use wdReplaceOne, instead, and the Selection (or Range object, if that is used) will move to the found content.
You might want to test whether something was actually found before issuing the .Cut command as that could have unexpected consequences if nothing is found (delete content at the point where the macro was initiated). For example:
Sub FindReplaceAndCut()
Dim found As Boolean
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "(\\\[)(*)(\\\])"
.Replacement.Text = "\2"
.Forward = True
.wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
found = Selection.Find.Execute(Replace:=wdReplaceOne)
If found Then
Selection.Cut
End If
End Sub
I need selection particular content each paragraph in ms word 2013. I try to select content using by vba script..
Sub RepalaceStrong()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "<Strong"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Extend
With Selection.Find
.Text = "</Strong>"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
End Sub
But i tried this code, i can't select one by one text.
Input:
In general, a vector field is a function whose domain is a set of points in <Strong> a vector field is </Strong> a vector field is <Strong>function</Strong> whose domain is a set of points
>In general, a vector field is a function whose <Strong>domain</Strong> is a set of points
Is it possible to select one by one all strong elements...
You need to specify the correct font formatting in your find operation (note the .Font.Bold = True part below):
With Selection.Find
.ClearFormatting
.Font.Bold = True
.Replacement.ClearFormatting
.text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Then, of course, it depends what you want to do with the bold text. Currently the code above just configures the Find object to search for bold text.
It's not strong you're looking for, it's Font.Bold
Option Explicit
Sub FindBold()
Dim myDoc As Document
Set myDoc = ThisDocument
Dim searchRange As Range
Dim foundRange As Range
Set searchRange = myDoc.Range(0, myDoc.Range.End)
With searchRange.Find
.ClearFormatting
.Forward = True
.Font.Bold = True
.Execute
Do While .Found
Set foundRange = searchRange
foundRange.Select
foundRange.Collapse direction:=wdCollapseEnd
MsgBox "Found bold text."
.Execute
Loop
End With
End Sub
My ans:
Sub RepalaceStrong()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "<Strong"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Extend
With Selection.Find
.Text = "</Strong>"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Collapse Direction:=wdCollapseEnd
End Sub
I got it ....
I created a macro that finds an instance of style H1 followed by style H2, and inserts a page break between them. And reiterates this till it gets to the end of the document.
However, the macro adds multiple page breaks (maybe 50 of them) instead of just one.
what did I do wrong and how to correct this?
The code:
Sub Force_page_break()
'
' Force_page_break Macro
'
'
Dim Eloop As Integer
Eloop = 1
Selection.HomeKey Unit:=wdStory
Do While Eloop = 1
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 1")
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
If Selection.Find.Execute = False Then
Eloop = 0
Exit Do
End If
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 2")
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchKashida = False
.MatchDiacritics = False
.MatchAlefHamza = False
.MatchControl = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.HomeKey Unit:=wdLine
Selection.InsertBreak Type:=wdPageBreak
Loop
ActiveDocument.Save
End Sub
Maybe you can add a line
Eloop = Eloop + 1
after the line
Selection.InsertBreak Type:=wdPageBreak
to get out of the loop?
I have a dictionary in MS Word format which I'd like to have cleaned from any paragraph breaks within dictionary entries, and keep only paragraph breaks that separate any two dictionary entries. This is how the layout of the dictionary looks now:
First picture http://img43.imageshack.us/img43/6476/snapshotpr.jpg
I'd need a macro or a regular expression that would first remove all the paragraph breaks, from the document, which would produce this layout:
Second picture http://img824.imageshack.us/img824/5219/snapshot1i.jpg
and then in the next step would add paragraph breaks only before the dictionary entries, which means only before bold phrases followed by the phonetic transcription in square brackets, to get this layout:
Third picture http://img849.imageshack.us/img849/2003/snapshot2qf.jpg
I used this site to help me with the paragraph markers.
Again, I recorded a macro with something did manually with 4 find/replace (two steps were used to make sure that a word followed by a square bracket was matched). Here's the macro:
Sub Separator()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^13"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Bold = True
With Selection.Find
.Text = "\["
.Replacement.Text = "^&"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Font.Bold = True
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "[a-z\-]# \["
.Replacement.Text = "^p^&"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Font.Bold = True
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Bold = False
.Italic = False
End With
With Selection.Find
.Text = "\["
.Replacement.Text = "["
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Let me know if there's anything to tweak and I'll try to change it :)
EDIT: Part added for hyphens.
My intent is to create a very basic macro to find a series of words and highlight them. Unfortunately, I do not know how to do multiple words in one step. For example, the following code works:
Sub Macro1()
'
' Macro1 Macro
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
.Text = "MJ:"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
However, if I add in another .Text = line, then the MJ: is ignored. Any ideas?
If you are only looking for a few words simply doing multiple find and replaces within the same macro will accomplish what you want. For example, the following will highlight in yellow all occurrences of "target1" and "target2"
Sub HighlightTargets()
' --------CODE TO HIGHLIGHT TARGET 1-------------------
Options.DefaultHighlightColorIndex = wdYellow
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
.Text = "target1"
.Replacement.Text = "target1"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
' --------CODE TO HIGHLIGHT TARGET 1-------------------
Options.DefaultHighlightColorIndex = wdYellow
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
.Text = "target2"
.Replacement.Text = "target2"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Alternatively the following code will let you add all the terms to highlight in one line which may be easier to work with.
Sub HighlightTargets2()
Dim range As range
Dim i As Long
Dim TargetList
TargetList = Array("target1", "target2", "target3") ' put list of terms to find here
For i = 0 To UBound(TargetList)
Set range = ActiveDocument.range
With range.Find
.Text = TargetList(i)
.Format = True
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute(Forward:=True) = True
range.HighlightColorIndex = wdYellow
Loop
End With
Next
End Sub
I had done the following modification. Perhaps not as elegant as the array. But I was thinking along the lines of a user simply pasting a list of values into a field.
Sub HighlightKeyword(SearchWord As String)
'
' HighlightKeyword Macro
'
Options.DefaultHighlightColorIndex = wdYellow
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
.Text = SearchWord
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Sub HighlightKeywordList()
'
' HighlightKeywordList
'
'
Dim HighlightList As String
Dim WordList As Variant
HighlightList = "Lorem Ipsum,amit,Finibus,Bonorum,et Malorum,Vestibulum,Vivamus,Integer"
WordList = Split(HighlightList, ",")
For i = 0 To UBound(WordList)
HighlightKeyword (WordList(i))
Next i
End Sub