The ClearFormatting method only works with the Selection object. Can I clear formats of a range without losing the selection, and ideally without caching it and calling Select. I'd like to clear formats for a Range
I've tried some combinations of Find/Replace, e.g.
Sub ClearFormat(ByVal doc As Document)
'doc.Content.Find.ClearFormatting 'WdStoryType.wdMainTextStory
Dim target As Range
Set target = doc.Content
With target.Find
.Replacement.Font.Name = "Regular" 'hoping this will reset to my normal style
.MatchWildcards = True
.Execute "*", Replace:=wdReplaceAll
End With
End Sub
And also setting the whole document style to the "Normal" style, but no joy
For example:
With ActiveDocument.Range
.ParagraphFormat.Reset
.Font.Reset
End With
Related
Newbie Jan here with his first question
I am trying to understand the behavior of my vba code. The code is searching for words/sentences with a specific format. When found I would like to adjust these words/sentences by modifying the range that is returned. If I adjust the range as this
that does not produce any problem (loop continues). If I delete the returned range the loop also continues.
Dim myFind As Find
Dim myRange As Range
Set myRange = Application.ActiveDocument.Content
Set myFind = myRange.Find
With myFind
.ClearFormatting
.Font.Underline = wdUnderlineDouble
.Font.Italic = True
End With
Do While myFind.Execute = True
myRange.Font.Bold = True
myRange.Font.StrikeThrough = True
Loop
However If I adjust the format that is used in the search (myRange.font.italic = false) then the loop exit after the first found.
Dim myFind As Find
Dim myRange As Range
Set myRange = Application.ActiveDocument.Content
Set myFind = myRange.Find
With myFind
.ClearFormatting
.Font.Underline = wdUnderlineDouble
.Font.Italic = True
End With
Do While myFind.Execute = True
myRange.Font.Italic = False
Loop
Can someone help me understand why this happens? If I delete the range (myRange.delete) the loop continues (which confuses me). It seems I cannot undo the formatting of what I am searching in this way... but deleting the range gives no problem. I tried to find documentation about this but I am unable to find information about my specific problem.
I have worked around this by selecting the range and then executing the next find and then modifying the selection. This works... but I would still like to understand what is happening.
P.S. This is just a part of the code. The code will be used to create some revisions. That is the reason I do not use the find/replacement options
Thanks!
some extra context
I am dealing with big word files and I want to automatically find 'specially formatted text' and modify this text automatically. Eventually I want the formatted text to become a track change/revision (that is also the reason I do not use the find/replace options). But I would first like to understand what is happening in my code. I understand that the .execute is returning a false and that this is the reason of the exit of the loop. I do not understand why .execute is returning a false while there are still other words/sentences in the document that have the format I was searching for
When using Find in VBA it is best to set .Wrap = wdFindStop to avoid getting into a continuous loop.
If you are not going to use Replace it is also good practice to assign the result of Execute to a variable (although there is a Found property it is considered unreliable).
Performing actions on the found range and then continuing the Find requires the use of Execute again in the loop. It is also necessary to collapse the found range so that Find can continue past it.
When the Find criteria are met the range is redefined to the found range. If you change the properties of that range so that they no longer meet the Find criteria Do While myFind.Execute = True evaluates as False, ending the loop.
The following routine works for all the conditions you mention in your question.
Sub FindFormatting()
Dim findRange As Range
Dim findSucess As Boolean
Set findRange = ActiveDocument.Content
With findRange.Find
.ClearFormatting
.Font.Underline = wdUnderlineDouble
.Font.Italic = True
.Wrap = wdFindStop
findSucess = .Execute
Do While .Found
With findRange.Font
.Italic = False
End With
'collapse range to continue
findRange.Collapse wdCollapseEnd
findSucess = .Execute
Loop
End With
End Sub
This probably should be a comment, but I am too new to add a comment.
I can verify that this happens on my system. To clarify, what you are trying to do is change the formatting for your targets to remove them from the search criteria after you have done your double-strikethrough and bold?
Your code is exiting the loop after the first pass to remove the Italics. That means it has finished the find. I can't explain this.
When I substitute the following for the code changing Italics, I get a message box for each instance found.
`MsgBox "Still in Loop"`
I'm still not clear on why you are not using the Replace function.
================== EDIT - ADDED IN RESPONSE TO COMMENT ==================
Try the following. It is going through the document multiple times but seems to work.
`Sub replacer()
' https://stackoverflow.com/questions/63766819/ms-word-vba-find-object-by-format-and-then-change-that-format-not-using-the-rep
Dim myFind As Find
Dim myRange As Range
Set myRange = Application.ActiveDocument.Content
Set myFind = myRange.Find
With myFind
.ClearFormatting
.Font.Underline = wdUnderlineDouble
.Font.Italic = True
End With
Do While myFind.Execute = True
myRange.Font.Bold = True
myRange.Font.StrikeThrough = True
Loop
'
StartOver:
Set myRange = Application.ActiveDocument.Content
Set myFind = myRange.Find
With myFind
.ClearFormatting
.Font.Underline = wdUnderlineDouble
.Font.Italic = True
.Font.StrikeThrough = True
.Font.Bold = True
End With
Do While myFind.Execute = True
' MsgBox "Still in Loop"
myRange.Font.Italic = False
If myFind.Found = True Then GoTo StartOver
Loop
End Sub`
I still have no explanation for why this is happening.
I'd like to find several strings within Word document and for each string found, I like to print (debug.print for example) the whole row content where the string is found, not the paragraph.
How can I do this? Thanks
Sub FindStrings
Dim StringsArr (1 to 3)
StringsArr = Array("string1","string2","string3")
For i=1 to 3
With
Selection.Find
.ClearFormatting
.Text = Strings(i)
Debug.Print CurrentRow 'here I need help
End With
Next
End Sub
The term Row in Word is used only in the context of a table. I assume the term you mean is Line, as in a line of text.
The Word object model has no concept of "line" (or "page") due to the dynamic layout algorithm: anything the user does, even changing the printer, could change where a line or a page breaks over. Since these things are dynamic, there's no object.
The only context where "line" can be used is in connection with a Selection. For example, it's possible to extend a Selection to the start and/or end of a line. Incorporating this into the code in the question it would look something like:
Sub FindStrings()
Dim StringsArr As Variant
Dim bFound As Boolean
Dim rng As Word.Range
Set rng = ActiveDocument.content
StringsArr = Array("string1", "string2", "string3")
For i = LBound(StringsArr) To UBound(StringsArr)
With rng.Find
.ClearFormatting
.Text = StringsArr(i)
.Wrap = wdFindStop
bFound = .Execute
'extend the selection to the start and end of the current line
Do While bFound
rng.Select
Selection.MoveStart wdLine, -1
Selection.MoveEnd wdLine, 1
Debug.Print Selection.Text
rng.Collapse wdCollapseEnd
bFound = .Execute
Loop
End With
Set rng = ActiveDocument.content
Next
End Sub
Notes
Since it's easier to control when having to loop numerous times, a Range object is used as the basic search object, rather than Selection. The found Range is only selected for the purpose of getting the entire line as these "Move" methods for lines only work on a Selection.
Before the loop can continue, the Range (or, if we were working with a selection, the selection) needs to be "collapsed" so that the code does not search and find the same instance of the search term, again. (This is also the reason for Wrap = wdFindStop).
I have several Word-Files containing old-style non-clickable UTF8-character checkboxes () and I want to replace them with real, clickable Checkboxes. They should be unchecked for and checked for another specified UTF8-character (which I do not know the number of right now).
I tried search and replace and copying from macros I've found online. I'm not a word user and this is a one-time-task, so I sadly do not have the time to learn VBA well enough to write such a thing as a macro.
I've found this online, but in the Macros-Window, I cannot even copy to "string to be searched".
For Each myStoryRange In ActiveDocument.StoryRanges
With myStoryRange.Find
.Text = "string to be searched"
.Replacement.Text = "string to be replaced"
.Wrap = wdFindContinue
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Highlight = False
.Execute Replace:=wdReplaceAll
End With
Next myStoryRange
For Searching UTF=8 Character you have to search Unicodes like
U+2610 decimal ☐ Unchecked Checkbox
U+2611 decimal ☑ Checked Checkbox
U+2612 decimal ☒ Crossed Checkbox
Other like Unicode characters may also be explored for exactly what is it in your case. I tested with U+2610 decimal ☐ Unchecked Checkbox.
For replacement with FormField type of ComboBox I successfully used the code below
Sub TestFormFieldCB()
Dim Rng As Range, cb As FormField
ActiveDocument.Content.Select
With Selection.Find
.Text = ChrW(9744)
Do While .Execute
Set Rng = Selection.Range
ht = Rng.Font.SizeBi
Rng.Delete
Set cb = Rng.FormFields.Add(Rng, wdFieldFormCheckBox)
cb.CheckBox.Size = ht
Loop
End With
'ActiveDocument.Protect wdAllowOnlyFormFields
End Sub
The disadvantage of this type ComboBox is document is to be protected for the ComboBox to be clickable.
As Second option I tried with ActiveX Type ComboBox. It is easilyclickable even in unprotected mode but difficult to align and size with the text in the line. Also Somehow i could not use the same find Loop as in the above code and had to work around with some other way.
The final tested code is
Sub testActiveXCB()
Dim Rng As Range, cb As InlineShape, Fnd As Boolean
ActiveDocument.Content.Select
With Selection.Find
.Text = ChrW(9744)
.Execute
Do While Selection.Find.Found
Set Rng = Selection.Range
ht = Rng.Font.SizeBi
Rng.Delete
Set cb = Rng.InlineShapes.AddOLEControl(ClassType:="Forms.CheckBox.1")
Debug.Print cb.OLEFormat.Object.Name & "-" & cb.Height
cb.Width = cb.Height
cb.Width = ht
cb.OLEFormat.Object.Caption = ""
cb.OLEFormat.Object.PicturePosition = 2
'Use next Line when replacing Checked Unicode Char mat be U+2611 or U+2612
'cb.OLEFormat.Object.Value = True
ActiveDocument.Content.Select
Selection.Find.Execute
Loop
End With
End Sub
(All tests are carried out in Word 2007 only)
I request more answers and eager to learn from Word VBA experts regarding
Why the ActiveX Combo Box could not be inserted with the simple Find loop used in case of FormField type Combo Box?
How to effectively align Active X Combo Box with the text Line?
I have several word documents to modify on a weekly basis that contain tables ranging from 1 x 6 up to 6 x 10 in size. All of the cells in all of the tables contain text, some of the cells contain text that is bold, some cells have mixed formatting(bold and standard), and the rest of the cells are standard.
I am trying to find code for a macro to change the background color in every cell that contains bold text, even it it also contains standard text.
This is pretty simple and I was able to find several different solutions for the this, but I run into the following issue in all code examples I have tried.
All of the examples I have tried will change the background color in all of the cells containing only bold text, but ignores the cells with mixed formatting(bold and standartd). I have tried several different ways to work around this but just don't have the knowledge to overcome the issue.
Here is a sample of the code I am using:
Sub Fill_Bold_Cell()
Dim myCell
For Each myCell In Selection.Tables(1).Range.Cells
If myCell.Range.Font.Bold = True Then
myCell.Range.Shading.BackgroundPatternColor = -603923969
End If
Next myCell
End Sub
Any help with this issue is greatly appreciated.
This pair of procedures should do the job.
Sub Fill_Bold_Cell()
Dim Tbl As Table
Dim myCell
For Each Tbl In ActiveDocument.Tables
For Each myCell In Tbl.Range.Cells
If FindBold(myCell.Range) Then
myCell.Range.Shading.BackgroundPatternColor = -603923969
End If
Next myCell
Next Tbl
End Sub
Private Function FindBold(Rng As Range) As Boolean
With Rng.Find
.ClearFormatting
.Font.Bold = True
.Text = ""
.Format = True
.Forward = True
.Wrap = wdFindStop
.Execute
FindBold = .Found
End With
End Function
As you see, I have kept your code almost unchanged. The critical part which was giving you a problem was moved into a separate function. In the way, the part which is good doesn't get contaminated by the part that isn't.
I need to automate the insertion of comments into a word document: searching for a predefined set of words (sometimes word strings, and all non case-sensitive) each to which I add a predefined comment.
There are two word sets, with two goals:
Wordset 1: identical comment for each located word
Wordset 2: individual comments (I suggest new text based on the word identified)
I have been semi-automating this with a code that IDs all identified words and highlights them, helping me through the process (but I still need to enter all the comments manually - and I've also been able to enter comments - but only on one word at a time.) As my VBA skills are limited, my attempts to compile a robust macro from bits of other code with similar purposes has unfortunately led me nowhere.
Below are the bits of code I've been using.
Sub HighlightWordList()
Dim range As range
Dim i As Long
Dim TargetList
TargetList = Array("word1", "word2", "word3")
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
The following code has been able to get me to insert bubbles directly
Sub CommentBubble()
'
'
Dim range As range
Set range = ActiveDocument.Content
Do While range.Find.Execute("Word x") = True
ActiveDocument.Comments.Add range, "my comment to enter in the bubble"
Loop
End Sub
I've tried to have the process repeat itself by doing as shown below, but for reasons I'm certain are evident to many of you (and completely unknown to me) - this strategy has failed, working for "word x" but failing to function for all subsequent words:
Sub CommentBubble()
'
'
Dim range As range
Set range = ActiveDocument.Content
Do While range.Find.Execute("Word x") = True
ActiveDocument.Comments.Add range, "my 1st comment to enter in the bubble"
Loop
Do While range.Find.Execute("Word y") = True
ActiveDocument.Comments.Add range, "my 2nd comment to enter in the bubble"
Loop
End Sub
I've mixed and matched bits of these codes to no avail. Any ideas to help me with either wordset?
Thanks for everyone's help!
Best regards
Benoit, you're almost there! All you need to do is redefine the range object after your first loop (because it would have been exhausted at that point). Like so:
Sub CommentBubble()
Dim rng As range
Set rng = ActiveDocument.Content
Do While rng.Find.Execute("Word x") = True
ActiveDocument.Comments.Add rng, "my 1st comment to enter in the bubble"
Loop
Set rng = ActiveDocument.Content ' <---------------Add This.
Do While rng.Find.Execute("Word y") = True
ActiveDocument.Comments.Add rng, "my 2nd comment to enter in the bubble"
Loop
End Sub
That should do the trick for you (it works on my end). If not, let me know.