I'm trying to iterate through all the paragraphs which are not within a table and highlighting the text as such:
'Iterate All Paragraphs
Dim p
objWord.Options.DefaultHighlightColorIndex = finalColor
For Each p In objDoc.Paragraphs
p.Range.Select
If Not objWord.Selection.Information(wdWithInTable) Then
With objWord.Selection.Range.Find
.ClearFormatting
.Highlight = False
.Forward = True
.Wrap = wdFindStop
.Replacement.ClearFormatting
.Replacement.Highlight = True
.Execute , , , , , , True, wdFindStop, , , wdReplaceAll
End With
End If
Next
The condition objWord.Selection.Information(wdWithInTable) works just fine, however the Find/Execute is replacing all non highlighted text throughout the document, even if within tables.
Any guesses as why?
I don't really think you should be using the Find object for this, but if you insist, perhaps you should store the Selection.Range in a variable first, then use the .Find property of that.
I would do it something like this:
Sub HighlightNonTableParagraphs()
Dim oDocument As Document
Dim oParagraph As Paragraph
Dim oRange As range
Set oDocument = ActiveDocument
For Each oParagraph In oDocument.Paragraphs
With oParagraph.range
If Not .Information(wdWithInTable) Then
.HighlightColorIndex = wdBlue
End If
End With
Next
End Sub
Related
I have found a code that finds a specific keyword and inserts the relative hyperlink which is specified. But the macro seems to only do one keyword at a time and is unable to do multiple. For example, in the code below it the macro will change the last SearchText to the correct hyperlink. Is there any way it could do multiple I'm looking to do this for website blogging so there would actually be over a 100 Keywords and relative hyperlinks? Any would help would be greatly appreciated.
Private Sub HyperlinkText_Click()
Dim SearchRange As Range
Dim SearchText As String
Dim WebAddress As String
Set SearchRange = ActiveDocument.Range
SearchText = "AMD41"
WebAddress = "http://www.example.com/"
SearchText = "AMD42"
WebAddress = "http://www.examples.com/"
With SearchRange.Find
Do While .Execute(SearchText, , True, , , , True) = True
With SearchRange
.Hyperlinks.Add SearchRange, WebAddress
End With
SearchRange.Collapse wdCollapseEnd
Loop
End With
End Sub
I tried just adding more SearchText and WebAddress and thought it might add multiple hyperlinks to the relative keywords.
Potentially very fast, especially where you have multiple instances of the same expression to convert:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, ArrFnd, ArrRep
ArrFnd = Array("AMD41", "AMD42")
ArrRep = Array("http://www.example.com/", "http://www.examples.com/")
With ActiveDocument
For i = 0 To UBound(ArrFnd)
.Hyperlinks.Add Anchor:=.Range(0, 0), Address:=ArrRep(i), TextToDisplay:=ArrFnd(i)
.Hyperlinks(1).Range.Cut
With .Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Format = False
.Wrap = wdFindContinue
.Text = ArrFnd(i)
.Replacement.Text = "^c"
.Execute Replace:=wdReplaceAll
End With
.UndoClear
Next
End With
Application.ScreenUpdating = True
End Sub
All you need ensure is that you have the same number of entries for ArrFnd and ArrRep.
I am trying to create a Word macro that will:
Search for a specific word (i.e. "see")
Select the entire paragraph where that word appears
Make the whole paragraph a different style (i.e. make it all red text)
Do the same thing with a second word (i.e. "blacklist")
Select that whole paragraph and apply a different style (i.e. again, make the paragraph red text)
Copy all paragraphs with the red text style and paste them in to a new word document
Unfortunately, I'm no VBA expert and I'm trying to cobble things together from what I can find online. I have found a great example that will select to the start of the paragraph, but I can't seem to figure out how to select the entire paragraph. Any help is appreciated!
** Sorry - here is the code I currently have. It will find all instances of the word "see" and selects to the start of the paragraph, then changes the color to red... but that's as far as I've gotten, as I am stuck on trying to figure out how to get it to select to the end of the paragraph.
Sub TestOne()
'
' TestOne Macro
'
'
If MsgBox(Prompt:="Would you like to update selected paragraph styles?", Buttons:=vbYesNo + vbQuestion, _
Title:="Format MD Report") = vbNo Then
Exit Sub
End If
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "see"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = False
End With
Do While .Find.Execute
i = i + 1
.Start = .Paragraphs.First.Range.Start
.Font.Color = wdColorRed
.Start = .Paragraphs.First.Range.End
Loop
End With
Application.ScreenUpdating = True
MsgBox i & " instances processed."
End Sub
For example, without needing to create a second document:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, StrFnd As String
StrFnd = "see|blacklist"
With ActiveDocument.Range
.Font.Hidden = True
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Text = "^&"
.Font.Hidden = True
.Replacement.Font.Hidden = False
.Format = True
.Forward = True
.MatchWildcards = True
.Wrap = wdFindContinue
For i = 0 To UBound(Split(StrFnd, "|"))
.Text = "[!^13]#" & Split(StrFnd, "|")(i) & "*^13"
.Execute Replace:=wdReplaceAll
Next
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
End With
Application.ScreenUpdating = True
End Sub
You could, of course, add a line of code before the final 'End With' to save the document with a new name.
To select the entire paragraph, following the line
.Start = .Paragraphs.First.Range.Start
add
.End = .Paragraphs.First.Range.End
... then to match only whole words, after
.MatchWildcards = False
add
.MatchWholeWord = True
And to run the code for multiple words you should add a parameter to your Sub eg
Sub TestOne(theWord As String)
then replace
.Text = "see"
with
.Text = theWord
And to run your code for each required word, add a Sub such as
Sub RunMe()
TestOne "see"
TestOne "blacklist"
End Sub
... optionally, move your MsgBoxes into RunMe()
In the Microsoft Word VBA editor, I'm trying to write a macro that finds and replaces a certain character with another character only within certain strings of text, not the whole document. For instance, I might want to replace decimal commas with decimal points (not all commas with periods), or a space with a hyphen in certain phrases. A big constraint is that the changes must be tracked via Track Changes, so finding and replacing the whole string of text isn't an option: Some customers think it looks weird and/or sloppy if I replace their numbers with themselves, and they have also worried that some of their data might have gotten changed. (It might also look like I let my computer make edits for me automatically, which I want to avoid.)
I can already do this clunkily by using Selection.Find to find certain strings (or patterns), doing Selection.Collapse, moving the cursor left or right, deleting a comma, and typing a period. I'm hoping there is a faster way to do this, possibly using ranges, but I have had little success finding or replacing anything using Word's Range object. Since I want to run several macros that total well over a hundred possible find-and-replace actions for each document, I'd like to streamline them all as much as possible.
What I've tried so far
For ease of illustration, I'll take the specific examples in which I want to find commas within statistical p-values written as "0,05", "0,01", or "0,001" and change them to periods, but not make this change anywhere else. I'm aware that in real life, searching for those strings could catch numbers in the thousands, millions, etc., but these are just simplified examples for learning/illustration purposes.
(1) The following works fine, it just strikes me as slow when done for many different Find strings in every document.
With Selection.Find
.ClearFormatting
.Text = "0,05"
.MatchWholeWord = True
.MatchWildcards = False
.Forward = True
.Wrap = wdFindContinue
End With
Do While Selection.Find.Execute
Selection.Collapse
Selection.MoveRight unit:=wdCharacter, count:=1
Selection.Delete unit:=wdCharacter, count:=1
Selection.TypeText (".")
Loop
(2) The most promising other way was adapted from VBA Word: I would like to find a phrase, select the words before it, and italicise the text:
Sub RangeTest()
Dim Rng As Range
Dim Fnd As Boolean
Set Rng = Selection.Range
With Rng.Find
.ClearFormatting
.Execute findText:="0,05", Forward:=True, _
format:=False, Wrap:=wdFindContinue
Fnd = .found
End With
If Fnd = True Then
With Rng
.Find.Wrap = wdFindContinue
.Find.Text = ","
.Find.Replacement.Text = "."
.Find.Execute Replace:=wdReplaceOne
End With
End If
End Sub
but it replaces the comma with a period in only the first "0,05" in the document, not all of them.
When I change wdReplaceOne to wdReplaceAll, then every comma in the document gets replaced with a period.
When I try every possible combination of wdFindContinue/wdFindStop (both times) and wdReplaceAll/wdReplaceOne, either one comma gets changed to a period or every one in the document does.
When I change the "If…Then" statement do a "Do While…Loop" statement, Word hangs:
Dim Rng As Range
Dim Fnd As Boolean
Set Rng = Selection.Range
With Rng.Find
.ClearFormatting
.Execute findText:="0,05", Forward:=True, _
format:=False, Wrap:=wdFindStop
Fnd = .found
End With
Do While Fnd = True
With Rng
.Find.Text = ","
.Find.Replacement.Text = "."
.Find.Execute Replace:=wdReplaceAll
End With
Loop
Is there any way to loop the "If…Then" statement or get the "Do While…Loop" method to work without hanging?
(3) I tried to adapt the code from this page https://www.techrepublic.com/article/macro-trick-how-to-highlight-multiple-search-strings-in-a-word-document/
Sub WordCollectionTest()
Dim Word As Word.Range
Dim WordCollection(2) As String
Dim Words As Variant
WordCollection(0) = "0,05"
WordCollection(1) = "0,01"
WordCollection(2) = "0,001"
'This macro behaves weirdly if insertions and deletions aren't hidden (more than one period gets inserted).
With ActiveWindow.view
.ShowInsertionsAndDeletions = False
For Each Word In ActiveDocument.Words
For Each Words In WordCollection
With Selection.Find
.ClearFormatting
.Text = Words
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = False
.MatchWholeWord = True
End With
Do While Selection.Find.Execute
Selection.Find.Text = ","
Selection.Find.Replacement.Text = "."
Selection.Find.Execute Replace:=wdReplaceAll
Loop
Next
Next
End With
End Sub
but this replaces every comma in the document with a period. (It's also kind of slow.)
(4) I tried putting the Find terms in an array rather than a word collection:
Sub ArrayTest()
Dim vDecimalCommas As Variant
Dim i As Long
vDecimalCommas = Array("0,05", "0,01", "0,001")
'This macro behaves weirdly if insertions and deletions aren't hidden:
With ActiveWindow.view
.ShowInsertionsAndDeletions = False
For i = LBound(vDecimalCommas) To UBound(vDecimalCommas)
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = vDecimalCommas(i)
.Forward = True
.Wrap = wdFindContinue
.matchcase = False
.MatchWholeWord = False
.MatchWildcards = True
End With
Do While Selection.Find.Execute
Selection.Find.Text = ","
Selection.Find.Replacement.Text = "."
Selection.Find.Execute Replace:=wdReplaceAll
Loop
Next
End With
End Sub
but this only replaces the comma with a period in the second of those numbers that it comes across, oddly enough.
I tried a variant of the Array method:
Sub ArrayTest()
For i = LBound(vDecimalCommas) To UBound(vDecimalCommas)
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ","
.Replacement.Text = "."
.Forward = True
.Wrap = wdFindContinue
.matchcase = False
.MatchWholeWord = False
.MatchWildcards = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
End Sub
But this replaces every comma in the document with a period (which isn't surprising, since I don't think the For i statement has any bearing on the Find and Replace commands in this version).
I've tried lots of other variants that I haven't mentioned here. I've tried combining the Array method with the Range/Boolean method. I've tried every variant I know of of the Find, Selection, For i, For Each, If Then, and Do While commands. And every time, only one comma gets replaced with a period or every one does.
Is there some way to define a range that consists of a certain string of text so that word will find and replace commas with periods within that range, every time, and nowhere else? Is there a way to define many such strings in one array or some other kind of list? Or any other way to find and replace commas with periods only within certain strings? I'm far from an expert, so a tiny variation of one of the above methods might work.
Try this:
Sub Tester()
Dim doc As Document
Set doc = ActiveDocument
'must turn off markup first or you'll end up in a loop...
If doc.TrackRevisions Then
doc.Windows(1).View.RevisionsFilter.Markup = wdRevisionsMarkupNone
End If
Debug.Print ReplaceAll(ActiveDocument, "0,001", ",", ".")
If doc.TrackRevisions Then
doc.Windows(1).View.RevisionsFilter.Markup = wdRevisionsMarkupAll
End If
End Sub
Function ReplaceAll(doc As Object, qText As String, _
qOld As String, qNew As String) As Long
Dim rng As Object, pos As Long, n As Long
Set rng = doc.Range
ResetFindParameters rng 'reset Find to defaults
With rng.Find
.Text = qText
Do While .Execute
pos = InStr(rng.Text, qOld)
Do While pos > 0
n = n + 1
rng.Characters(pos).Text = qNew
pos = InStr(rng.Text, qOld)
Loop
Loop
End With
ReplaceAll = n
End Function
'reset any Find settings
Sub ResetFindParameters(oRng As Object)
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = 1 'wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True '<< adjust following to suit
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
End Sub
I'm generating some security report in Microsoft Word - importing SOAP xml requests and responses...
I want to automate this process as much as I can and I need to highlight some text in these requests/responses. How to do that? In general I need to highlight non-standart inputs in requests (every time different - bad data types and so on) and fault strings in responses (in majority looks like this <faultstring>some error</faultstring>).
Heres code Im trying:
Sub BoldBetweenQuotes()
' base for a quotes finding macro
Dim blnSearchAgain As Boolean
' move to start of doc
Selection.HomeKey Unit:=wdStory
' start of loop
Do
' set up find of first of quote pair
With Selection.Find
.ClearFormatting
.Text = "<faultstring>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Execute
End With
If Selection.Find.Found Then
Selection.MoveRight Unit:=wdCharacter, Count:=1
' switch on selection extend mode
Selection.Extend
' find second quote of this pair
Selection.Find.Text = "</faultstring>"
Selection.Find.Execute
If Selection.Find.Found Then
Selection.MoveLeft Unit:=wdCharacter, Count:=Len(Selection.Find.Text)
' make it bold
Selection.Font.Bold = True
Selection.Collapse Direction:=wdCollapseEnd
Selection.MoveRight Unit:=wdCharacter, Count:=1
blnSearchAgain = True
Else
blnSearchAgain = False
End If
Else
blnSearchAgain = False
End If
Loop While blnSearchAgain = True
End Sub
It highlights just the first faultstring, but other appearences stay unformated nad I dont know why.... Thanks for your reply.
The most efficient way to do this is to work with multiple Range objects. Think of a Range as being like an invisible selection, with the important difference that, while there can be but one Selection object there can be multiple Range objects in your code.
I've adapted your code, adding three Range objects: one for the entire document; one for finding the starting tag; one for finding the end tag. The Duplicate property is used to "copy" one Range from another (this due to an oddity in Word if you Set one Range to another, which links them).
For clarity I also added a couple more Boolean test values for your Ifcomparisons. In my experience, it's more reliable to pick up the "success" directly from Execute than to rely on Find.Found after-the-fact.
Sub BoldBetweenQuotes()
' base for a quotes finding macro
Dim blnSearchAgain As Boolean
Dim blnFindStart As Boolean
Dim blnFindEnd As Boolean
Dim rngFind As word.Range
Dim rngFindStart As word.Range
Dim rngFindEnd As word.Range
Set rngFind = ActiveDocument.content
Set rngFindStart = rngFind.Duplicate
Do
' set up find of first of quote pair
With rngFindStart.Find
.ClearFormatting
.Text = "<faultstring>"
.Replacement.Text = ""
.Forward = True
.wrap = wdFindStop
blnFindStart = .Execute
End With
If blnFindStart Then
rngFindStart.Collapse wdCollapseEnd
Set rngFindEnd = rngFindStart.Duplicate
rngFindEnd.Find.Text = "</faultstring>"
blnFindEnd = rngFindEnd.Find.Execute
If blnFindEnd Then
rngFindStart.End = rngFindEnd.Start
' make it bold
rngFindStart.Font.Bold = True
rngFindStart.Start = rngFindEnd.End
rngFindStart.End = rngFind.End
blnSearchAgain = True
Else
blnSearchAgain = False
End If
Else
blnSearchAgain = False
End If
Loop While blnSearchAgain = True
End Sub
I happen to have problems trying to manipulate the below code to my liking.
First off, the code below deletes everything in between the start and end conditions I have stipulated in my program.
I would like to change this, to delete everything besides those stipulated between the start and end words.
Sub SomeSub()
Dim StartWord As String, EndWord As String
Dim Find1stRange As Range, FindEndRange As Range
Dim DelRange As Range, DelStartRange As Range, DelEndRange As Range
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Setting up the Ranges
Set Find1stRange = ActiveDocument.Range
Set FindEndRange = ActiveDocument.Range
Set DelRange = ActiveDocument.Range
'Set your Start and End Find words here to cleanup the script
StartWord = "From: Research.TA#traditionanalytics.com|Tradition Analytics Commentary| | |"
EndWord = "This message has been scanned for malware by Websense. www.websense.com"
'Starting the Find First Word
With Find1stRange.Find
.Text = StartWord
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
'Execute the Find
Do While .Execute
'If Found then do extra script
If .Found = True Then
'Setting the Found range to the DelStartRange
Set DelStartRange = Find1stRange
'Having these Selections during testing is benificial to test your script
DelStartRange.Select
'Setting the FindEndRange up for the remainder of the document form the end of the StartWord
FindEndRange.Start = DelStartRange.End
FindEndRange.End = ActiveDocument.Content.End
'Having these Selections during testing is benificial to test your script
FindEndRange.Select
'Setting the Find to look for the End Word
With FindEndRange.Find
.Text = EndWord
.Execute
'If Found then do extra script
If .Found = True Then
'Setting the Found range to the DelEndRange
Set DelEndRange = FindEndRange
'Having these Selections during testing is benificial to test your script
DelEndRange.Select
End If
End With
'Selecting the delete range
DelRange.Start = DelStartRange.Start
DelRange.End = DelEndRange.End
'Having these Selections during testing is benificial to test your script
DelRange.Select
'Remove comment to actually delete
DelRange.Delete
End If 'Ending the If Find1stRange .Found = True
Loop 'Ending the Do While .Execute Loop
End With 'Ending the Find1stRange.Find With Statement
End Sub
Hah! That's a new twist There's certainly more than one way to go about it; my inclination would be to work with (at least) three Ranges. Something like this:
Sub FindAndDeleteEverythingElse()
Dim strFind1 As String, strFind2 As String
Dim rngDoc As word.Range, rngFind1 As word.Range
Dim rngFind2 As word.Range
Dim bFound As Boolean
strFind1 = "You"
strFind2 = "directly."
Set rngDoc = ActiveDocument.content
Set rngFind1 = rngDoc.Duplicate
Set rngFind2 = rngDoc.Duplicate
With rngFind1.Find
.Text = strFind1
bFound = .Execute
End With
If bFound Then
With rngFind2.Find
.Text = strFind2
bFound = .Execute
End With
If bFound Then
rngDoc.End = rngFind1.Start
rngDoc.Delete
rngDoc.Start = rngFind2.End
rngDoc.End = ActiveDocument.content.End
rngDoc.Delete
End If
End If
End Sub
The "main" Range is that of the entire document: ActiveDocument.Content. The Range object is a bit different than other objects, if you set one Range to another it becomes that Range, not a copy. So you need the Duplicate method to make a copy of a Range. This lets you use Find independently for the various Ranges.
If the first Find is successful, the second one is executed. If that is also successful then the Document Range's end-point is set to the starting point of the successful Find and the content of the Range deleted. The Document Range is then re-defined to start at the end-point of the second found Range and end at the end of the Document, and deleted.
You will probably have to set more Range.Find properties than I did in this code snippet - I used the absolute minimum to make working with the Ranges clearer.
There maybe another way but till then you can do this.
try to add dummy character after and before your string like this
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = False
.Text = "From: Research.TA#traditionanalytics.com|Tradition Analytics Commentary| | |"
.Replacement.Text = "From: Research.TA#traditionanalytics.com|Tradition Analytics Commentary| | |######"
.Execute Replace:=wdReplaceAll
.Text = "This message has been scanned for malware by Websense. www.websense.com"
.Replacement.Text = "######This message has been scanned for malware by Websense. www.websense.com"
.Execute Replace:=wdReplaceAll
End With
End With
End Sub
Then try to set range between ###### and ######
this is best answer to set range select a range of text from one Word document and copy into another Word document
Please note that in my word 2007 it is not possible to find within hyperlinks. Try to remove all hyperlink or within range before doing replacement.
another best answer for that: How do you remove hyperlinks from a Microsoft Word document?