How to select two words in a paragraph VBA - vba

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

Related

Creating a cloze test using Word VBA

As a beginner, I am trying to write a Word Macro that can automatically mark and convert one third of the words in an article to a cloze format. In the past, I have manually added equal signs before the desired word and then ran the following macro to complete the process. However, I am now attempting to automate this manual step by creating a new macro that will randomly add equal signs to the prefixes of the words in one-third of the selected range. After running this new macro, I plan to use the previous macro to finish the conversion to the cloze format. However, I am unsure how to set up the new macro to perform the marking and would appreciate any suggestions or guidance.
This is the conversion macro that is already done:
Sub Convert()
Application.ScreenUpdating = False
selection.HomeKey Unit:=wdStory 'init
Dim iCount, A, i As Long
Dim RPT, CHAR, WordRpt, Eventual As Integer
iCount = 0
WordRpt = 1
Eventual = 0
selection.Find.ClearFormatting 'A and I
selection.Find.Replacement.ClearFormatting
selection.HomeKey Unit:=wdStory
With ActiveDocument.Content.Find 'sum A
.text = "=a "
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute
A = A + 1
Loop
End With
selection.HomeKey Unit:=wdStory
With ActiveDocument.Content.Find 'sum I
.text = "=i "
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute
i = i + 1
Loop
End With
With selection.Find
.text = "=a "
.Replacement.text = "_ "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
selection.Find.Execute replace:=wdReplaceAll
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "=i "
.Replacement.text = "_ "
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
selection.Find.Execute replace:=wdReplaceAll
With ActiveDocument.Content.Find 'sum equals
.text = "="
.Format = False
.Wrap = wdFindStop
Do While .Execute
iCount = iCount + 1
Loop
End With
While WordRpt <= iCount
WordRpt = WordRpt + 1
With selection.Find 'next equal
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Execute FindText:="="
selection.TypeBackspace
selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
CHAR = Len(selection) - 2
selection.MoveLeft Unit:=wdCharacter, Count:=1
selection.MoveRight Unit:=wdCharacter, Count:=1, Extend:=wdExtend
selection.Cut
selection.MoveRight Unit:=wdWord, Count:=1, Extend:=wdExtend
selection.PasteAndFormat (wdFormatOriginalFormatting)
UdsRpt = 1 'underscore
Do While UdsRpt <= CHAR
UdsRpt = UdsRpt + 1
selection.TypeText text:="_"
Loop
selection.TypeText text:=" "
End With
Wend
'
' patch comma
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ ,"
.Replacement.text = "__,"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch period
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ ."
.Replacement.text = "__."
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch question mark
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ ?"
.Replacement.text = "__?"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch excalmation mark
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ !"
.Replacement.text = "__!"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch slash
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ /"
.Replacement.text = "__/"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch back slash
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ \"
.Replacement.text = "__\"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch colon
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ :"
.Replacement.text = "__:"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch semi colon
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ ;"
.Replacement.text = "__;"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch dash
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ –"
.Replacement.text = "__–"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch hyphen
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ -"
.Replacement.text = "__-"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
'
' patch ellipsis
'
'
selection.Find.ClearFormatting
selection.Find.Replacement.ClearFormatting
With selection.Find
.text = "_ …"
.Replacement.text = "__…"
.Forward = True
.ClearFormatting
.MatchWholeWord = True
.MatchCase = False
.Wrap = wdFindContinue
End With
selection.Find.Execute replace:=wdReplaceAll
Eventual = A + i + iCount
MsgBox "Successfully converted" & Eventual & "words.", vbOKOnly, "Task Completed"
Application.ScreenUpdating = True
End Sub
This simple macro will insert an equals sign before words in a selection with a probability of 1 in 3.
Sub InsertEqualsSigns()
Randomize
Dim targetWord As Range
For Each targetWord In Selection.Range.Words()
targetWord.Select
Selection.MoveLeft Unit:=wdWord, Count:=1
If Rnd() < 1 / 3 Then
Selection.TypeText Text:="="
End If
Next
End Sub
Note that this is currently just set to add an equals sign, so change the text to insert "=a " or "=i " as preferred as I'm not sure the exact close formatting.

How to find and replace the Calibri font using VBA in MS Word

I am going to find the Calibri font in my document and replace with same content and same font (Calibri) with XML tag before and after <Cal></Cal>. I manually find and replacing each time. If i recorded this as a macro it not working.
Sub Caliberi_Font()
'
' Caliberi_Font Macro
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = "<cal>^&</cal>"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
If i modify (or add) the line Selection.Find.Font.Name = "Calibri" to the macro then also not working
Sub Caliberi_Font()
'
' Caliberi_Font Macro
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Font.Name = "Calibri"
With Selection.Find
.Text = ""
.Replacement.Text = "<cal>^&</cal>"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
My Input DOC file in Calibri font
My Input DOC file
My Output DOC file need to replace
My required output
Try:
Sub Calibri_Font()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Font.Name = "Calibri"
.Text = ""
.Replacement.Text = "<cal>^&</cal>"
.Forward = True
.Format = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub

Giving multiple hyperlinks in MS-Word VBA based on own delimiter

I am new to VBA scripting. I am converting TeX file to Word document using GrindEq convertor. In this TeX file there have multiple \hrefcommands. Here content only coming in MS-Word file (i.e. https://doi.org/10.1016/0167-6423(87)90036-0). So far i am putting tag before and after for that content <LaTeX-href-http>https://doi.org/10.1016/0167-6423(87)90036-0</LaTeX-href-http> using python. By this content was producing with Tag in MS-Word file.
Similarly for converting to Small Caps font, converting to Monospace font, i have recorded the macro and modify as per my own needs and used.
Sub XXX_SmallCaps()
'
' XXX_SmallCaps Macro
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.SmallCaps = True
.AllCaps = False
End With
With Selection.Find
.Text = "\<LaTeX-SmallCaps\>(*#)\</LaTeX-SmallCaps\>"
.Replacement.Text = "\1"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
'
' XXX_Serif Macro
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Size = 13
Selection.Find.Replacement.Font.Name = "Calibri"
With Selection.Find
.Text = "\<LaTeX-SerifFont\>(*#)\</LaTeX-SerifFont\>"
.Replacement.Text = "\1"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
'
' XXX_MonoSpace
'
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Size = 12
Selection.Find.Replacement.Font.Name = "Courier New"
With Selection.Find
.Text = "\<LaTeX-MonospaceFont\>(*#)\</LaTeX-MonospaceFont\>"
.Replacement.Text = "\1"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
But how to give the Hyperlinks for the content in between the Tags <LaTeX-href-http>...</LaTeX-href-http> and <LaTeX-href-http> and </LaTeX-href-http> tags need to deleted using in VBA? Please refer the image for my DOC file.
For example (including cleaning up your other code):
Sub ReformatLaTeX()
Application.ScreenUpdating = False
Dim StrLnk As String
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Format = False
.Forward = True
.Wrap = wdFindContinue
.MatchWildcards = True
.Replacement.Text = "\1"
.Replacement.Font.SmallCaps = True
.Text = "\<LaTeX-SmallCaps\>(*#)\</LaTeX-SmallCaps\>"
.Execute Replace:=wdReplaceAll
.Replacement.ClearFormatting
.Replacement.Font.Size = 13
.Replacement.Font.Name = "Calibri"
.Text = "\<LaTeX-SerifFont\>(*#)\</LaTeX-SerifFont\>"
.Execute Replace:=wdReplaceAll
.Replacement.Font.Size = 12
.Replacement.Font.Name = "Courier New"
.Text = "\<LaTeX-MonospaceFont\>(*#)\</LaTeX-MonospaceFont\>"
.Execute Replace:=wdReplaceAll
.Replacement.ClearFormatting
.Text = "\<LaTeX-href-http\>*#\<\/LaTeX-href-http\>"
.Replacement.Text = ""
.Wrap = wdFindStop
End With
Do While .Find.Execute
StrLnk = Split(Split(.Text, "</LaTeX-href-http>")(0), "<LaTeX-href-http>")(1)
.Hyperlinks.Add Anchor:=.Duplicate, Address:=StrLnk, TextToDisplay:=StrLnk
.Start = .Hyperlinks(1).Range.End
Loop
End With
Application.ScreenUpdating = True
End Sub

Use VBA regular expression in Word Find/Replace macro?

I often use a legacy text editor (Vim) to take meeting notes because I can keep up with the talking. However, most people (including myself) prefer the final notes to be in Word, with bullets and sub-bullets. Here is an example of a text file that I wanted to convert to Word bullets:
Meeting notes
-------------
* The quick brown fox
* The quick brown fox
- Jumped over the lazy dogs
- Jumped over the lazy dogs
* The quick brown fox
I recorded a macro to convert text bullets to Word bullets. Any paragraph starting with text bullet "*" gets converted to "List Bullet 2", then I globally replace "*" with "" (i.e., deleted). Any paragraph starting with the more indented text bullet " -" gets converted to "List Bullet 4", then I globally delete " -". The "BulletsTxt2wrd" macro is shown below.
The problem is, I use Word's Find/Replace function, which can't really restrict the search of the above strings to the beginning of a paragraph. If there is a "*" in the middle of the paragraph (perhaps "25 * 3.1415"), the same paragraph formatting and deletion occurs.
Regular expressions can confine searches to the start of a paragraph. I used regular expressions in a unix environment, and after years of reading that it can be done in VBA, I used it in simple Excel function to convert time durations specified in days/minutes to hours. For example (see "DurtnStr2hrs" function below:
"20 hours" becomes 20
"1 hour" becomes 1
"1 day" becomes 24
"3 days" becomes 3*24
"1 minute" becomes 1/60
"70 minutes" becomes 70/60
I use this function within a spreadsheet cell, with the argument being another cell containing the string to be converted.
Is there a way to use the regular expression package and objects in the "BulletsTxt2wrd" Word macro? It seems to function like a black box, and the VBA code doesn't really expose the object property containing the string that I want to operate on.
P.S. This post doesn't deal with the Find/Replace method that I recorded, which goes through the entire document to locate matches.
This post refers to VBScript, but I really would like to avoid having to figure out another language to accomplish my simple task.
This post also doesn't use the Find/Replace recorded in my macro.
Sub BulletsTxt2wrd()
'
' BulletsTxt2wrd Macro
'
'
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("List Bullet 2")
With Selection.Find
.Text = " * "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " * "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("List Bullet 4")
With Selection.Find
.Text = " - "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = " - "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub
Function DurtnStr2hrs(str) As Double
' Use for DurtnHrs column
Dim NewStr As String
Dim regex1 As Object
Set regex1 = New RegExp
NewStr = str
regex1.Pattern = " hours?"
NewStr = regex1.Replace(NewStr, "")
regex1.Pattern = " minutes?"
NewStr = regex1.Replace(NewStr, "/60")
regex1.Pattern = " days?"
NewStr = regex1.Replace(NewStr, "*24")
DurtnStr2hrs = Evaluate(NewStr)
End Function
«The problem is, I use Word's Find/Replace function, which can't really restrict the search of the above strings to the beginning of a paragraph» Au contraire, you could use:
Sub Demo1()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^13[ *-]{1,}"
.Replacement.Text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
End With
Do While .Find.Execute
.Start = .Start + 1
Select Case Trim(.Text)
Case "*": .Paragraphs.Last.Style = wdStyleListBullet2
Case "-": .Paragraphs.Last.Style = wdStyleListBullet4
End Select
.Text = vbNullString
.Collapse wdCollapseEnd
Loop
End With
Application.ScreenUpdating = True
End Sub
As for the DurtnStr2hrs conversion, I note there remains a disconnect between your text description of ""20 hours" becomes 20*60" and your Regex of "NewStr = regex1.Replace(NewStr, "/60")". That said, try:
Sub Demo2()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "<[0-9]# [dh][ao][yu]*>"
.Replacement.Text = ""
.Format = False
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
End With
Do While .Find.Execute
.Start = .Start + 1
Select Case Split(.Text, " ")(1)
Case "hour": .Text = Split(.Text, " ")(0)
Case "hours": .Text = Split(.Text, " ")(0) & "/60"
Case "day": .Text = "24"
Case "days": .Text = Split(.Text, " ")(0) & "*24"
End Select
.Collapse wdCollapseEnd
Loop
End With
Application.ScreenUpdating = True
End Sub
The following seems to do the job:
Sub BulletTxt2doc()
doL1bullet:
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^p * "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Selection.Find.Execute
If .Found = True Then
Selection.EndKey Unit:=wdLine
Selection.Style = ActiveDocument.Styles("List Bullet 2")
Selection.MoveUp Unit:=wdParagraph, Count:=1
Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
GoTo doL1bullet
End If
End With
doL2bullet:
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "^p - "
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Selection.Find.Execute
If .Found = True Then
Selection.EndKey Unit:=wdLine
Selection.Style = ActiveDocument.Styles("List Bullet 4")
Selection.MoveUp Unit:=wdParagraph, Count:=1
Selection.MoveRight Unit:=wdWord, Count:=2, Extend:=wdExtend
Selection.Delete Unit:=wdCharacter, Count:=1
GoTo doL2bullet
End If
End With
End Sub

To find and replace a text in the whole document in MS Word 2010 (including tables)

I have an MS Word document including a table. I am trying to find and replace text via VBA using the following code:
If TextBox1.Text <> "" Then
Options.DefaultHighlightColorIndex = wdNoHighlight
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = True
With Selection.Find
.Text = "<Customer_Name>"
.Replacement.Text = TextBox1.Text
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.ClearFormatting
With Selection.Find.Font
.Italic = True
End With
Selection.Find.Replacement.ClearFormatting
With Selection.Find.Replacement.Font
.Italic = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End If
This works fine for replacing all my content which is outside of the table. But it will not replace any of the content within the table.
If your goal is to perform replacements in the whole documents (it looks so from the code, but it is not explicit), I would suggest you use Document.Range instead of the Selection object. Using Document.Range will make sure everything is replaced, even inside tables.
Also, it is more transparent to the user, as the cursor (or selection) is not moved by the macro.
Sub Test()
If TextBox1.Text <> "" Then
Options.DefaultHighlightColorIndex = wdNoHighlight
With ActiveDocument.Range.Find
.Text = "<Customer_Name>"
.Replacement.Text = TextBox1.Text
.Replacement.ClearFormatting
.Replacement.Font.Italic = False
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
End If
End Sub
I have used the following code and it works like charm..... for all the occurances that are found in the document.
stringReplaced = stringReplaced + "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