I have seen multiple articles about this topic but none of them helped in my case and most of them were for Excel. I want to change the font color using vba code in word. I have tried Selection.Font.Color but it didn't work either. I know that vba needs a variable which have that particular word but I'm failing on doing this.
Does anyone know how to do this?
I used a workaround to replace the font color of a word using this vba code
With Selection.Find
.ClearFormatting
.Text = "hello"
.Replacement.ClearFormatting
.Replacement.Text = "hi"
.Replacement.Font.Color = wdColorBlack 'I added this line
.Execute Replace:=wdReplaceAll, Forward:=True, _
Wrap:=wdFindContinue
End With
But I was looking to more a specific way to replace the font color of a word in vba.
If you want a re-usable piece of code then something like this should be close:
Sub Tester()
ActiveDocument.Content.Font.Color = vbBlack
ColorText ActiveDocument.Content, "breaks", vbRed
ColorText ActiveDocument.Content, "it", vbBlue
ColorText ActiveDocument.Content, "with just", vbGreen
End Sub
Sub ColorText(rng As Range, strFind As String, clr As Long)
With rng.Find
.Text = strFind
.Forward = True
.Format = False
.MatchCase = False
.MatchWholeWord = True
Do While .Execute()
rng.Font.Color = clr 'rng is redefined as the found text
Loop
End With
End Sub
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
this is my first post in this forum and I am also doing my first steps in word VBA, so please be patient with a poor latin teacher.
This is what I want to do:
In my active document I select a text with several words (or parts of words) formatted red. These words are the correct solutions for a CLOZE question (fill in the blank). Here is an example (red = bold):
Galli ad oppidum venerunt.
Caesar Q. Pedium legatum in Galliam misit.
This should become:
Romani ad oppidum (veniunt) {1:SHORTANSWER:=venerunt}.
Caesar Q. Pedium legatum in Galliam (mittit) {1:SHORTANSWER:=misit}.
So what I have to do is:
Find all red text snippets,
Foreach found red textsnippet insertBefore "{1:SHORTANSWER:=}" and insertAfter "}".
I tried to work with Selection.Find.Font.Color = wdColorRed, but then, how do I get hold of each 'instance' and how do I loop through it? The Find-Object has a property Text, but that is always empty :-(
Can you help me please?
Kind regards
Thomasina
For example:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = ""
.Replacement.Text = ""
.Font.ColorIndex = wdRed
.Format = True
.Forward = True
.Wrap = wdFindStop
End With
Do While .Find.Execute
.InsertBefore "{1:SHORTANSWER:="
.Collapse wdCollapseEnd
.Text = "}"
.Font.ColorIndex = wdAuto
.Collapse wdCollapseEnd
Loop
End With
Application.ScreenUpdating = True
End Sub
It's not apparent where '(veniunt)' and '(mittit)' are supposed to come from, however.
It's also not clear whether the F/R is supposed to insert the paragraph breaks.
My goal is to write a VBA Macro for Word 2003, where the user selects part of a table (especially a column), and the macro maps input characters to specific output characters, e.g. any of a e i o u become V; some sequences like eh uw become V; one character (exclamation mark) is deleted; anything not turned into "V" is turned into "C". My problem is that after the first replace, the selection gets "unset", so changes affect something other than the original selection.
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = True
.Replacement.Text = "V"
.Text = "[aeiouáéíóú]"
.Execute Replace:=wdReplaceAll
'replace certain sequences
.Text = "[mn" & ChrW(618) & ChrW(650) & "]" & ChrW(769)
.Execute Replace:=wdReplaceAll
.Text = "[mn]" & ChrW(768)
.Execute Replace:=wdReplaceAll
'delete !
.Text = "[\!]"
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
'everything else becomes C
.Text = "[!V]"
.Replacement.Text = "C"
.Execute Replace:=wdReplaceAll
End With
How do you get find/replace to only operate on the selected cells? I notice that after the first replace, Selection.End changes to the same value as Selection.Start. I do not understand how column selection works in Word.
I created some macros to facilitate this. This will start an answer on how to move around columns.
Sub GoToTop()
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument ' This takes the pointer to the body of the document ' place cursor the body of the document in case you are located on the header
Selection.EndKey Unit:=wdStory 'key ctrl end
Selection.HomeKey Unit:=wdStory 'key ctrl end
End Sub
Sub GoToColumnTable() 'place cursor inside of the first column
Selection.GoTo What:=wdGoToTable
End Sub
Sub ColumnMove() 'move from one column to the other one
Selection.Move Unit:=wdColumn, Count:=1
End Sub
Sub ColumnSelect() 'select the entire column in which the cursor is
Selection.SelectColumn
End Sub
Sub ColumnDelete() 'delete a column that was selected
Selection.Columns.Delete
End Sub
I'm working on a Word 2007 template with a macro that will apply character styles to the selected text. It seemed that the Find/Replace feature would be a good place to start, but I think I've found a bug/limitation that prevents the macro from working as desired.
Here's my vba code:
Sub restyleSelection()
Dim r As Range
Set r = Selection.Range
With r.Find
.Style = ActiveDocument.Styles("Default Paragraph Font")
.Text = ""
.Replacement.Text = ""
.Replacement.Style = ActiveDocument.Styles("Emphasis")
.Forward = True
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
End Sub
If I create a test document that contains a few paragraphs and select a few words in one of the paragraphs, then run the macro, the "Emphasis" style is applied not only to the selection, but beyond the end of the selection to the end of the document.
This behavior is the same using the actual GUI Find/Replace tool.
My question is: How can I overcome this bug/limitation and apply the character style ONLY within the selection/range?
A little more information:
What I really need the macro to do is apply certain formatting to the entire selection while maintaining the existing character styles in the selection. For example, if the selected text contains the Bold character style, the Italic character style, and the rest of it is Default Paragraph Font, the macro should replace Bold with "Revised Bold", replace "Italic" with "Revised Italic", and replace "Default Paragraph Font" with "Revised". That way, when I use the companion macro to "undo" the action of this macro, the original character styles (Bold, Italic, Default Paragraph Font) can be replaced.
SOLVED:
Here is the solution I finally arrived at:
Sub applyNewRevisedText
Dim r As Range ' Create a new Range object
Set r = Selection.Range ' Assign the current selection to the Range
Dim rng As Range
For Each rng In r.Words
Set rngStyle = rng.Style
Select Case rngStyle
Case "Bold"
rng.Style = ActiveDocument.Styles("New/Revised Text Bold")
Case "Italic"
rng.Style = ActiveDocument.Styles("New/Revised Text Emphasis")
Case Else
rng.Style = ActiveDocument.Styles("New/Revised Text")
End Select
Next rng
End Sub
To answer your direct question
My question is: How can I overcome this bug/limitation and apply the
character style ONLY within the selection/range?
Does this not meet the need?:
Sub restyleSelection()
Selection.Style = ActiveDocument.Styles("Emphasis")
End Sub
EDIT:
Ok, based on your comment, what about something like:
Dim rng As Range
For Each rng In Selection.Words
If rng.Bold 'do something
Next rng
.Words will break up each word in the range into a collection of ranges. Then you can perform styling on each individual word based on its current style.
I had a slightly different problem and solved it without resorting to a loop. The code works NOT for text which is formatted directly, but it does work for text which is formatted with character styles.
Consider a part of the text being selected, either including or not including strings to which already some character style has been assigned.
If within the selected range no character style has been assigned yet, after the search the start of the selection won't be the same. If however at least one character style has been assigned the start of the selection will be the same as before the search. Now you can treat those two cases separately. In both cases all characters within the selection to which no character style had been assigned previously will now be linked to "myStyle".
Vst_Style = "myStyle"
ActiveDocument.Bookmarks.Add Name:="Range"
V_BMstart = Selection.Range.Start
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Default Paragraph Font")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles(Vst_Style)
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = True
End With
Selection.Find.Execute
If Selection.Range.Start <> V_BMstart Then
Selection.GoTo what:=wdGoToBookmark, Name:="Range"
Selection.Style = Vst_Style
Else
Selection.GoTo what:=wdGoToBookmark, Name:="Range"
Selection.Find.Execute Replace:=wdReplaceAll
End If