I have a selection in a word document which I set with
With Selection.Find
.Text = "Blala"
.Forward = True
.Wrap = wdFindContinue
.MatchCase = True
End With
Selection.Find.Execute
Selection.Extend
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Tada"
.Forward = True
.Wrap = wdFindStop
.MatchCase = True
End With
Selection.Find.Execute
But in that selection there are also tables, I only want to format text. Is there a way to exclude the tables from that selection?
Thanks!
This code loops through all paragraphs within the selection and only performs the replacement of "Blala" with "Tada" if there are no tables in that paragraph:
Sub ReplaceTextButSkipTables()
Dim rng As Range
Dim p As Paragraph
Set rng = Selection.Range
For Each p In rng.Paragraphs
If p.Range.Tables.Count = 0 Then
With p.Range.Find
.ClearFormatting
.MatchCase = True
With .Replacement
.ClearFormatting
.ParagraphFormat.LeftIndent = InchesToPoints(1.27)
End With
.Execute FindText:="Blala", ReplaceWith:="Tada", Replace:=wdReplaceAll
End With
End If
Next p
End Sub
Related
I have a Word macro that does hundreds of find and replace operations, but currently it applies the operations to the entire document. I need it to only apply to text between "Abstract" (bold, match case) and "References" (bold, match case).
The current code applies changes to the whole document, and then at the end of the macro, it retrospectively rejects any changes to the References with the following code:
With Selection.Find
.ClearFormatting
.Font.Bold = True
.MatchCase = True
.Forward = True
.Execute FindText:="References"
If .Found = True Then
Selection.Find.Execute
Selection.Collapse wdCollapseStart
Dim r1 As Range
Set r1 = Selection.Range
Selection.Find.Text = "DummyText"
Selection.WholeStory
Selection.Collapse wdCollapseEnd
Dim r2 As Range
Set r2 = ActiveDocument.Range(r1.start, Selection.start)
r2.Select
If Selection.Range.Revisions.Count >= 1 Then _
Selection.Range.Revisions.RejectAll
End If
End With
This selects the text between "References" in bold and "DummyText", which is just some text that's guaranteed not to be found so it selects to the end of the document, and then rejects any changes within that selection.
I've tried adapting this and putting it at the start of the macro so that all the find and replace operations only apply to the selection between the Abstract and the References like this:
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Abstract"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.Font.Bold = True
.MatchCase = True
.MatchWholeWord = True
End With
Selection.Find.Execute
Selection.Collapse wdCollapseStart
Dim r1 As Range
Set r1 = Selection.Range
Selection.Find.Text = "References"
Dim r2 As Range
Set r2 = ActiveDocument.Range(r1.start, Selection.start)
r2.Select
' Move cursor to start, turn on tracked changes
Selection.HomeKey Unit:=wdStory
ActiveDocument.TrackRevisions = True
With ActiveWindow.View.RevisionsFilter
.markup = wdRevisionsMarkupSimple
.View = wdRevisionsViewFinal
End With
' start replacements (these go on for ages, two examples here)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Also "
.Replacement.Text = "Additionally, "
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "Therefore "
.Replacement.Text = "Therefore, "
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
' and so on...
Other threads I've read seem to suggest
.Wrap = wdFindStop
in the replace fields would do what I want, but that doesn't work.
Can anybody help? Cheers.
For example:
Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "Abstract"
.Font.Bold = True
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
End With
Do While .Find.Execute
Set Rng = .Duplicate
With .Duplicate
.End = ActiveDocument.Range.End
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "References"
.Font.Bold = True
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
.Execute
End With
If .Find.Found = True Then
Rng.End = .Duplicate.End
Rng.Revisions.RejectAll
End If
End With
Loop
End With
Application.ScreenUpdating = True
End Sub
The above code accommodates multiple 'Abstract' and 'References' blocks, if needed.
You need to use multiple ranges. Once you have established the range to search then if you find something, the first thing you must do is make sure what you found is within the range. The example code below does that.
Sub FindInRange()
Dim rng As Word.Range, rStart As Long, rEnd As Long
Dim iRng As Word.Range
Set rng = ActiveDocument.Content
With rng.Find
.ClearFormatting
.Format = True
.Forward = True
.Font.Bold = True
.MatchCase = True
.MatchWholeWord = True
.Text = "Abstract"
.Wrap = wdFindStop
.Execute
If .found = True Then
rStart = rng.End
rng.Collapse Word.WdCollapseDirection.wdCollapseEnd
.Text = "References"
.Execute
If .found Then
rEnd = rng.Start
End If
End If
End With
If rStart > 0 And rEnd > 0 Then
Set iRng = rng
iRng.Start = rStart
iRng.End = rEnd
Else
Exit Sub
End If
Set rng = iRng
With rng.Find
.ClearFormatting
.Format = True
.Forward = True
.Font.Bold = True
.MatchCase = True
.MatchWholeWord = True
.Text = "Something"
.Wrap = wdFindStop
.Execute
If .found = True And rng.InRange(iRng) Then
'do something
End If
End With
End Sub
So I'm a total newbie when it comes to using VB. I am trying to highlight a word when it is not followed by another specific word within the next two words. I tried the following code but it seems to just the first word. Many thanks in advance.
Sub fek()
'
'
'
'
Selection.Find.ClearFormatting
With Selection.Find
.Text = "n."
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
If Selection.Find.Found = True Then
With Selection.Range
.MoveStart wdWord, 2
End With
With Selection.Find
.Text = "fek"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
End If
If Selection.Find.Found = False Then
Selection.Range.HighlightColorIndex = wdYellow
End If
End Sub
The code below should do what you want. You need to bear in mind that what Word defines as a Word can be different to what a human would, e.g. an IP address is counted as 7 words!
Sub fek()
Dim findRange As Range
Dim nextWords As Range
Set findRange = ActiveDocument.Content
With findRange.Find
.ClearFormatting
.Text = "n."
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute = True
'findRange is now the range of the match so set nextWords to the 2 next words
Set nextWords = findRange.Next(wdWord)
nextWords.MoveEnd wdWord, 3
'look for the specific text in the next two words
If InStr(nextWords.Text, "fek") = 0 Then findRange.HighlightColorIndex = wdYellow
'collapse and move findRange to the end of the match
findRange.Collapse wdCollapseEnd
findRange.Move wdWord, 4
Loop
End With
End Sub
The following would probably be significantly faster if there are many 'n.' strings in the document:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
i = Options.DefaultHighlightColorIndex
Options.DefaultHighlightColorIndex = wdYellow
With ActiveDocument.Range
With .Find
.Forward = True
.Format = False
.MatchCase = False
.Wrap = wdFindContinue
.MatchWildcards = True
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Highlight = True
.Text = "n."
.Replacement.Text = "^&"
.Execute Replace:=wdReplaceAll
.Replacement.Highlight = False
.Text = "n.[^s ]#fek"
.Execute Replace:=wdReplaceAll
.Text = "n.[^s ]#[!^s ]#fek"
.Execute Replace:=wdReplaceAll
.Text = "n.[^s ]<[!^s ]#>[^s ]#fek"
.Execute Replace:=wdReplaceAll
.Text = "n.[^s ]<[!^s ]#>[^s ]#[!^s ]#fek"
.Execute Replace:=wdReplaceAll
End With
End With
Options.DefaultHighlightColorIndex = i
Application.ScreenUpdating = True
End Sub
I need an MSWord macro to convert these below values :
568.63-
682.3-
12.78-
To
-568.63
-682.3
-12.78
You don't actually need a macro for this. All you need is a wildcard Find/Replace with:
Find = (<[0-9.]#)(-)
Replace = \2\1
As a macro, this would become:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "(<[0-9.]#)(-)"
.Replacement.Text = "\2\1"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End With
Application.ScreenUpdating = True
End Sub
As for the 80.9-100.1 issue identified by #Freeflow, I'd be inclined to replace those hyphens with something other than a normal hyphen (e.g. a non-breaking hyphen). In that case, you might use a macro coded like:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = True
.Text = "([0-9])-([0-9])"
.Replacement.Text = "\1^~\2"
.Execute Replace:=wdReplaceAll
.Text = "(<[0-9.]#)(-)"
.Replacement.Text = "\2\1"
.Execute Replace:=wdReplaceAll
End With
End With
Application.ScreenUpdating = True
End Sub
Thanks in advance for any reply.
I am working on presentation of some reports. The periodical reports are imported from a different software into Word template. For all tables and for each row I would like to change the color of the negative numbers in column 14 only if there is a certain text in column 3.
Unfortunately I have to use a Word template to do this. It seems that a macro is my only option so I have tried to Frankenstein something from different macros I found online:
Dim varColumn As Column
Dim clColumn As Column
Dim cCell As Variant
Set clColumn = Selection.Columns(3)
Set varColumn = Selection.Columns(14)
With clColumn
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.text = "value"
.Replacement.text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
If .Information(wdWithInTable) = True Then
Selection.MoveRight Unit:=wdCell, Count:=11
End If
If cCell < 0 Then
Selection.Font.color = wdColorRed
End If
Loop
End With
End Sub
I think the macro needs lines to repeat the search. See the two lines added before Loop.
With Selection
.HomeKey Unit:=wdStory 'Starts at the beginning, to search all tables.
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "value"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found
If .Information(wdWithInTable) = True And _
.Cells(1).ColumnIndex = 3 Then 'Confirms it's in the 3rd column.
.MoveRight Unit:=wdCell, Count:=11
End If
If .Range < 0 Then
.Font.Color = wdColorRed
End If
.Collapse wdCollapseEnd 'Collapses the selection to no characters.
.Find.Execute 'Searches again from the current selection point.
Loop
End With
Try:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "-[0-9][0-9,.]{1,}"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchWildcards = True
.Execute
End With
Do While .Find.Found = True
If .Information(wdWithInTable) = True Then
If .Cells(1).ColumnIndex = 14 Then
If Split(.Rows(1).Cells(3).Range.Text, vbCr)(0) = "specified text" Then
.Font.ColorIndex = wdRed
End If
End If
End If
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub
If the table might have vertically-merged cells, change:
If Split(.Rows(1).Cells(3).Range.Text, vbCr)(0) = "specified text" Then
to:
If Split(.Tables(1).Cell(.Cells(1).RowIndex, 3).Range.Text, vbCr)(0) = "specified text" Then
I have a paragraph in word containing:
"b) Vergabeverfahren Öffentliche Ausschreibung, VOB/A Vergabenummer 13A0295S. "
Is it possible to select following two words at the same time in this paragraph.
"b) Vergabeverfahren" and "Vergabenummer "
The reason is I want to change the selection color to red. I Can select one word successfully with this code. But selecting two words is a bit problematic for me.
Here is my code:
Selection.Start = singleLine.range.Start
Selection.End = singleLine.range.End
ReplaceText = StrFrmDll ' StrFrmDll contains the paragraph.
Selection.Find.ClearFormatting
With Selection.Find
.Text = ReplaceText
.Replacement.Text = ReplaceText
.Replacement.Font.Hidden = True
.ClearFormatting
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
End With
Selection.Find.Execute Replace:=wdReplaceOne
Selection.Font.Color = wdColorRed
Just do two of the Selection.Find's
Selection.Find.ClearFormatting
With Selection.Find
.Text = Vergabeverfahren
.Replacement.Font.Hidden = True
.ClearFormatting
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
End With
Selection.Find.Execute Replace:=wdReplaceOne
Selection.Font.Color = wdColorRed
Selection.Find.ClearFormatting
With Selection.Find
.Text = Vergabenummer
.Replacement.Font.Hidden = True
.ClearFormatting
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
End With
Selection.Find.Execute Replace:=wdReplaceOne
Selection.Font.Color = wdColorRed