This code used to work fine in word-VBA, but now it gives a runtime error 5854 (string parameter too long). How can I fix it? Please help!
Dim rngTemp As Range
Set rngTemp = ActiveDocument.Range(Start:=0, End:=0)
With rngTemp.Find
.ClearFormatting
.Highlight = False
.MatchWholeWord = True
With .Replacement
.ClearFormatting
.Highlight = True
End With
.Execute Replace:=wdReplaceAll, Forward:=True, FindText:=searchNo, ReplaceWith:=newtext, Format:=True
If .Found = True Then
totalCount = totalCount + 1
End If
End With
Related
How do you find all instances of the highlighted text in the active document and remove the highlight formatting with mark-up?
I found a macro in https://learn.microsoft.com/en-us/office/vba/api/word.find.highlight. But I want it to remove the highlight formatting with mark-up. I tried to add " ActiveDocument.TrackRevisions = True" to turn on the Track Changes but in vain.
Sub A()
Dim rngTemp As Range
Set rngTemp = ActiveDocument.Range(Start:=0, End:=0)
With rngTemp.Find
.ClearFormatting
.Highlight = True
With .Replacement
.ClearFormatting
.Highlight = False
End With
.Execute Replace:=wdReplaceAll, Forward:=True, FindText:="", _
ReplaceWith:="", Format:=True
End With
End Sub
Then I tried to record a Macro and edited it as follows:
Sub Macro1()
Selection.Find.ClearFormatting
Selection.Find.Highlight = True
With Selection.Find
.Text = ""
.Replacement.Text = "^&"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Options.DefaultHighlightColorIndex = wdNoHighlight
Selection.Range.HighlightColorIndex = wdNoHighlight
Selection.Find.Execute
End Sub
The second one can only change highlighted text to no highlight with mark-up one by one. It is not convenient since I have at least 200 highlighted texts to decide whether they should be corrected in a document. How can I edit it to automatically select all highlighted text and then remove their highlights with mark-ups?
Sub FindRemoveHighlighting()
Dim findRange As Range: Set findRange = ActiveDocument.Content
ActiveDocument.TrackRevisions = True
With findRange
With .Find
.Highlight = True
.Text = ""
.Format = True
End With
Do While .Find.Execute() = True
.HighlightColorIndex = wdNoHighlight
.Collapse wdCollapseEnd
Loop
End With
End Sub
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
this is my first post here!
I am new to Microsoft VBA, but I need to write some macros to quickly make the same changes to 200+ documents. I took the Udemy course on Word VBA but I am stuck trying to figure out how to address the following issues:
I need to select all content from beginning of doc up until the first occurrence of the string "following:" including the string itself - the issue is that for each doc, this string will always be in a different position and the portion I want to delete will vary in length. The only guarantee is that it will always be on the first page.
I need to do the same thing for the end of the document - I need to delete all content following the string "Affirmative Defenses" including the string itself - again, this will always be in a different position and will not always be on the last page (unlike issue number 1)
I have written many variations by reading other questions/solutions with no luck. Below is my current version but it does not work.
Sub DeleteBegin()
Dim findRng As Range
Set findRng = ActiveDocument.Range
Dim endPara As Long
With findRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "following."
.Replacement.Text = ""
.Wrap = wdFindStop
.MatchWholeWord = True
.Forward = True
.Execute
If .Found = True Then
endPara = GetParaNum(findRng)
findRng.Start = 0
findRng.End = endPara
End If
Dim capRng As Range
Set capRng = ActiveDocument.Range
capRng.SetRange Start:=0, End:=endPara
capRng.Select
Selection.Delete
End With
End Sub
Function GetParaNum(ByRef r As Object) As Integer
Dim rPara As Object
Dim CurPos As Long
r.Select
CurPos = ActiveDocument.Bookmarks("\startOfSel").Start
Set rPara = ActiveDocument.Range(Start:=0, End:=CurPos)
GetParaNum = rPara.Paragraphs.Count
End Function
Try:
Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument
Set Rng = .Range(0, 0)
With .Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "following."
.Replacement.Text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
.Execute
End With
If .Find.Found = True Then
Rng.End = .Duplicate.End
Rng.Delete
End If
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "Affirmative Defenses"
.Replacement.Text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchCase = True
.Execute
End With
If .Find.Found = True Then
Set Rng = .Duplicate
Rng.End = ActiveDocument.Range.End
Rng.Delete
End If
End With
End With
Application.ScreenUpdating = True
End Sub
I am using the following code to bold parts of a text string, in this case where the word 'Fish' is in brackets after the word 'Oil':
Sub ReplaceAndFormat16()
Dim sConst1 As String, sReplaceMent As String
Dim rRange As Range, rFormat As Range
sConst1 = "Fish"
sReplaceMent = "Oil (" & sConst1 & ")"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "Oil (Fish)"
.Replacement.Text = sReplaceMent
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceOne
If .Found Then
Set rRange = Selection.Range
Set rFormat = ActiveDocument.Range(rRange.Start + 5, rRange.Start + 5 + VBA.Len(sConst1))
rFormat.Font.Bold = True
End If
End With
End Sub
This code works perfectly, but only bolds the first instance, and my documents may have up to four instances of this phrase that need to be formatted bold.
How do I amend the code so it carries on and bolds all instances in the document? I am very new to VBA, so apologies if this seems like a stupid question.
Change the line
.Execute Replace:=wdReplaceOne
to
.execute Replace:=wdReplaceAll
Edit
OK the above was a stupid response. The code below does the right thing
Sub ReplaceAndFormat16()
Const myFindStr As String = "Oil (Fish)"
Dim myFindRange As Word.Range
Set myFindRange = ActiveDocument.StoryRanges(wdMainTextStory)
Do
With myFindRange.Find
.ClearFormatting
.Text = myFindStr
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
If .Found Then
With myFindRange
.MoveStartUntil cset:="fF"
.MoveEndUntil cset:="hH", Count:=wdBackward
.Font.Bold = True
.Collapse Direction:=wdCollapseEnd
End With
Else
Exit Sub
End If
End With
Loop
End Sub
How can I delete the text between <de> and the end-of-cell marker throughout my Word document?
I have reached the following code from my previous question. It appeared not to be working because my lines end with end-of-cell markers. So now I need to update this to delete the text between <de>and the end-of-cell marker.
I am unable to implement that in this code.
Sub FindTheDeleteToEndOfLine()
Dim searchTerm As String
Dim bFound As Boolean
searchTerm = "<de>"
Selection.HomeKey wdStory
'Basic Find settings
With Selection.Find
.Forward = True
.wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
'Execute the Find
Do
With Selection.Find
.Text = searchTerm
bFound = .Execute
If bFound Then
Selection.MoveEnd wdLine, 1
Selection.MoveEnd wdCharacter, -1
Selection.Delete
End If
End With
Loop While bFound
End Sub
Update: I worked out a new code less complicated, but again i am unale to define the arng.words in order to delete last part after <de>:
Dim arng As Range
Dim i As Long, j As Long
With Selection.Tables(1)
For i = 1 To .Rows.Count
For j = 1 To .Columns.Count
Set arng = .Cell(i, j).Range
arng.End = arng.End - 1
'Text = "<de>"
If Right(arng.Words, 1) = "<de>" Then
arng.Words.Last = Left(arng.Words, Len(arng.Words) - 1)
End If
Next j
Next i
End With
Try, for example:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "<de>"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While .Find.Found
If .Information(wdWithInTable) = True Then
.End = .Cells(1).Range.End - 1
.Delete
End If
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
End Sub
The problem you're encountering here is due to how Word reacts to a selection inside a cell: as soon as it reaches the end of the cell it selects the entire cell.
I've modified the code (which makes it more "complicated") to take this into account. In order to deal with this, there is now a Range object in the code that stores the original "Found" point in the document. After extending the selection to the end of the line, and moving it back one character (which means the entire cell is selected), the starting point is re-set to the "found" position.
Sub FindTheDeleteToEndOfCell()
Dim searchTerm As String
Dim bFound As Boolean
Dim rngFound As Word.Range
searchTerm = "<de>"
Selection.HomeKey wdStory
'Basic Find settings
With Selection.Find
.Forward = True
.wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
'Execute the Find
Do
With Selection.Find
.Text = searchTerm
bFound = .Execute
If bFound Then
Set rngFound = Selection.Range
Selection.MoveEnd wdLine, 1
Selection.MoveEnd wdCharacter, -1
Selection.Start = rngFound.Start
Selection.Delete
End If
End With
Loop While bFound
End Sub