In VBA, how to insert text before and after style? - vba

I have been trying to work out how to insert text before and after a given style in Word using VBA.
At present I run through the document from top to bottom, find the style, and make the insertions. It is time-consuing and inelegant (to say the least).
It should be possible to use a Range object and
Selection.InsertBefore ()
and
Selection.InsertAfter ()
but I can't get it to work.
Does anyone know how to do this?
This a second edit to give a better idea of the sort of thing I am looking for, but would need it modified to find a particular style:
Sub InsertBeforeMethod()
Dim MyText As String
Dim MyRange As Object
Set MyRange = ActiveDocument.Range
MyText = "<Replace this with your text>"
' Selection Example:
Selection.InsertBefore (MyText)
' Range Example: Inserts text at the beginning
' of the active document.
MyRange.InsertBefore (MyText)
End Sub
Another way it might be possible to fo this, is through using wildcards and style, but when I use (*) it only finds one character with the style, not the whole string.
Maybe there is some way to make it find the whole string? Then it would be possible to do a "replace all" with "mytext1"\1"mytext2"

Word has a feature to find and replace text with certain styles, so you don't even need a macro. But if you wish to automate it with VBA, the following sample code inserts foo in front of any Heading 2-styled code and appends bar afterwards:
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("Heading 2")
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ""
.Replacement.Text = "foo^&bar"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

Related

MS Word VBA Style and Pagebreak Cleanup

My company's workflow currently includes a process where we export documentation from a repository, clean it up a bit, and send it down the line for review/approval. The "clean it up a bit" involves running a macro that, among other things, does a find/replace on styles to change them from what comes out of the repository, to what is specified by our document template. So, for example, the repository gives us a style for "p_body," and we need that to be "body". This macro works pretty well, except for a couple of things that I'd like to see if we can polish up.
The first issue is that the repository tends to behave somewhat unpredictably when it comes to the styles that it delivers. To use the example from above, instead of tagging all of the "p_body" text in that style, it comes back with "p_body", "p_body_1", "p_body_1_1," and the like. Currently, the style switching in the macro is all hard-coded, so in order for the macro to fix something, it has to know it exists. Thus, if the repository spits out a style that's not already in the macro, it won't get fixed. I know that if I was dealing with an HTML doc, I could use a regular expression to find all versions of the "p_body" style, and replace them with "body." Is there a way to use such more intelligent find/replace version instead of hard-coding each style that needs to be replaced?
The second issue will take a separate question to fix, so it's now being snipped out.
For posterity, here's what one of the macro find/replace blocks looks like:
Selection.Find.ClearFormatting
Selection.Find.Style = ActiveDocument.Styles("p_body")
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Style = ActiveDocument.Styles("body")
With Selection.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
For dealing with the style name variations on p_body and others try this. You fill the StyName1 array with the names to find, and in the StyName2 array put the replacement names. It must be a one-for-one match-up.
This is just one of many ways to code it.
Sub StyleNames()
Dim StyName1 As Variant, StyName2 As Variant
StyName1 = Array("p_body", "p_bold")
StyName2 = Array("body", "bold")
Dim i As Long
Dim findStyName As String, replaceName As String
For i = LBound(StyName1) To UBound(StyName1)
findStyName = StyName1(i)
replaceName = StyName2(i)
FindAndReplaceStyles findStyName, replaceName
Next
End Sub
Private Function FindAndReplaceStyles(ByRef findStyName As String, ByRef replaceName As String)
Dim sty As Word.Style, aStory As Word.Range
For Each sty In ActiveDocument.Styles
If InStr(1, sty.NameLocal, findStyName) Then
For Each aStory In ActiveDocument.StoryRanges
With aStory.Find
.ClearFormatting
.Format = True
.Forward = True
.MatchWildcards = False
.Style = sty.NameLocal
.Text = ""
.Wrap = wdFindStop
.Replacement.ClearFormatting
.Replacement.Style = replaceName
.Replacement.Text = ""
.Execute Replace:=Word.wdReplaceAll
End With
Next
Exit For
End If
Next
End Function

How to add text to empty bullet points in Microsoft Word with VBA?

I am trying to add text to empty formatted bullet points in a word document, however I can't seem to find any successful way of doing so. I'm not very good at VBA, I just use it to automate reoccuring reports.
This is the format of VBA subs I've been using to find and replace text, I just can't find a way to adjust for adding to bullet points:
Private Sub FixedReplacements()
Dim Rng As Range
Dim SearchString As String
Dim EndString As String
Dim Id As String
Dim Link As String
Set Rng = ActiveDocument.Range
Rng.Find.ClearFormatting
Rng.Find.Replacement.ClearFormatting
With Rng.Find
.Text = ""
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Rng.Find.Execute Replace:=wdReplaceAll
End Sub
The goal I have set for empty bullet points is for them to display something along the lines of "No further information." << Just an example.
How this can be done depends very much on how the bullets were inserted. There is no way to specifically search the bullet, itself. A comment mentions
bullet points are the formatted bullet points found straight out of
word.
In that case, the default setting would be to format the paragraphs with the List Paragraph style. If that's the case, here, then Find can search for paragraphs using that style. The Find code in the question would then look as follows. (Note also the changes to the Format and Wrap properties.)
With Rng.Find
.Text = "^p"
.Replacement.Text = "No further information.^p"
.Forward = True
.Style = "List Paragraph"
.Wrap = wdFindStop
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
If a different style has been used to apply bullets, then that style name can be searched. Keep in mind that style names are case-sensitive.
There is an option in File/Options/Advanced, Editing options section: Use Normal style for bulleted or numbered lists. If this has been activated then things become very difficult. Best you can do is to try to match the applied paragraph formatting (indents, etc.).

Count replacements made by "Replace All" in VBA

I'm working on a macro that parses a document and modifies style when needed. So far, one of my sub uses Find & Execute with a loop to go through all paragraph with a defined Style. It worked well enough and made it easy to know how many times an modification is made.
However, it appears that .Execute Replace:=wdReplaceAll is far more efficient, but doesn't return this latter information in VBA, even though it is displayed when used directly in Word (with Ctrl + H).
How can I bypass this issue to count the number of replacements?
Thanks a lot in advance.
You could do this with a combination of Word's built in find and replace and a search and replace using the regex library (Microsoft VBScript Regular Expressions 5.5).
The VBScript regular expressions cannot search for styles, only text but can provide the number of matches found.
Thus you first do a search and replace for the paragraph marker of the style in which you are interested (^p + style). You replace the paragraph marker with an amended paragraph marker such as '###^p' being careful to replace with the same style.
You then use the regex search and replace to find the paragraph marker modifier and replace it with nothing, thus restoring the original text. The regex has a method .Matches.Count which will give you the number of replacements of ### that were made.
You may find the following stack overflow link of help
How to Use/Enable (RegExp object) Regular Expression using VBA (MACRO) in word
Try something based on:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = InputBox("What is the Text to Find")
.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
i = i + 1
.Collapse wdCollapseEnd
.Find.Execute
Loop
End With
Application.ScreenUpdating = True
MsgBox i & " instances found."
End Sub
The above code doesn't actually replace anything - it simply counts the instances of what's found.

Word 2016/VBA Highlight first use of each word from a word list

I am working on a macro for Word that accesses a separately saved doc file with a long word list of several pages. The word list doc is formatted like,
FMS
CPR
Abc
...to separate each word by the line break.
The macro needs to highlight the first use of each word from the list.
Right now, the macro highlights every use of the word, and in addition, highlights that word when it's part of another word. For example, it highlights EZE in the word freeze, but it should only highlight when eze stands alone.
Can someone help with how to,
1. highlight first-use only, and
2. how to make sure it's only catching the actual word, not all the other words that contain that word? I can't seem to make that happen with VBA.
My current code:
Sub TD()
'
Dim sCheckDoc As String
Dim docRef As Document
Dim docCurrent As Document
Dim wrdRef As String
Dim wrdPara As Paragraph
sCheckDoc = "c:\check.docx"
Set docCurrent = Selection.Document
Set docRef = Documents.Open(sCheckDoc)
docCurrent.Activate
With Selection.Find
.ClearFormatting
.Replacement.ClearFormatting
.Replacement.Highlight = True
.Replacement.Text = "^&"
.Forward = True
.Format = True
.MatchWholeWord = True
.MatchCase = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
For Each wrdPara In docRef.Paragraphs
wrdRef = wrdPara.Range.Text
If Asc(Left(wrdRef, 1)) > 32 Then
' remove the paragraph mark:
wrdRef = Left(wrdRef, Len(wrdRef) - 1)
With Selection.Find
.Wrap = wdFindContinue
.Text = wrdRef
.Execute Replace:=wdReplaceAll
End With
End If
Next wrdPara
docRef.Close
docCurrent.Activate
End Sub
Try wdReplaceOne instead wdReplaceAll.
.MatchWholeWord = True should prevent highlighting embedded strings but it seems to be ignored.
I tested your original code in module behind ThisDocument and it highlighted all instances of only the last string from check document, ignoring the MatchWholeWord parameter. After the suggested edit, the code highlighted first instance of only the last string from check document. Now I can't get the procedure to work. It runs but words do not highlight. I've never used VBA behind Word. Hope this change works for you.

Microsoft Word macro for formatting selected text, such as italics for all instances of e.g

this is my first question,
I have to go over a large number of documents and make sure that several formatting issues are correct. An example of such an issue would be to make sure that all periods, ".", are not bold, italics, underline, etc. Another example would be to make sure that all "etc." are in italics.
I have a list of the needed formatting issues.
Instead of going over each document and using the find/replace function I would rather write a macro that I can apply to each document.
I have no experience with VBA. I do on the other hand, have some experience with programming in C sharp and C in general.
Any help would be greatly appreciated.
BTW, I'm not asking for a complete program, rather a sample from which I can learn and continue with my own.
There are a couple options:
1.Under the Developer tab in Word, you can hit the "Record Macro" button and do a find and replace multiple times while recording the macro using the ctrl + H shortcut.
2.Have multiple smaller macros setup (such as the two below) hit the "Record Macro" and run them in the order that you want.
Sub ItalicizeEct()
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Italic = True
With Selection.Find
.Text = "ect."
.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
End Sub
Sub RemoveBoldPeriods()
Dim PunctAllRng As Word.Range
Set PunctAllRng = ActiveDocument.Range
With PunctAllRng.Find
.Format = True
.Text = "."
.Font.Bold = True
.Replacement.Text = "."
.Replacement.Font.Bold = False
.Execute Replace:=wdReplaceAll
End With
End Sub
3.Or simply write a large macro that will go through all the editing processes you need