Deleting Empty Paragraphs in Word - but not objects/pictures - vba

I'm using the macro from #Wayne G. Dunn on this question and it works great, but it doesn't understand when there are pictures/objects in my document and deletes them.
Would there be any way around it?
The said document is a Word file exported from an online app/software we use at work, if it helps. I don't know the specs of the picture.

The code in your linked thread is awful and is indeed liable to delete shapes attached to paragraphs. There is also no need to loop through every paragraph. Indeed, a macro isn't even needed for most cases. All you need is a wildcard Find/Replace, where:
Find = [^13]{2,}
Replace = ^p
As a macro, this becomes:
Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "[^13]{2,}"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End With
Application.ScreenUpdating = True
End Sub
Note: For systems using non-english regional settings, you may need to use:
[^13]{2;}
instead of:
[^13]{2,}
in both the Find/Replace and the macro.

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

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.

Conditional Replace in Word Macro

Hi all and thanks in advance for any replies;
This question is about replacing text only under certain conditions.
Background: I'm working on a macro for the editorial department of an academic institution. They get loads of documents that have the same issues and asked for some help to reduce the time they spend on each one.
Two of the things they want:
If a hyphen is between two digits, change it to an en-dash
Change every ampersand (&) to the word "and"
I have a RegExp that finds and replaces those hyphens just fine, but I noticed a problem. My find/replace changes the "display text" of hyperlinks. Same with ampersands. Bad. So what I'm trying to figure out is how to exclude text that has Selection.Style = Word.ActiveDocument.Styles("Hyperlink")
BTW, what's the logical operator for "not equal"? I tried <> and >< but I always get an error telling me that an expression is expected. I'm new to VBA so please forgive the newbie question.
This is working (part of a much larger Sub):
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([0-9])-([0-9])"
.Replacement.Text = "\1" & Chr$(150) & "\2"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
So can I create an If/Then statement to tell it to replace only if the style is not hyperlink?
Thanks again,
Rissa
P.S. I searched for similar posts and found one but it had never been answered.
Maybe a safer way to find out if your selection is a hyperlink is to use the following VBA code:
If Selection.Hyperlinks.Count = 1 Then
MsgBox "The selection is a hyperlink"
Else
MsgBox "The selection is not a hyperlink"
End If
I just tested it quickly and it works perfectly. To answer you second question, operations such as "=" and "<>" are for basic types such as Integer, Float, Long etc. Word.ActiveDocument.Styles("Hyperlink") returns an object. Therefore you would need to use "Is" and "Is Not"
Hope that helps.
(Thanks Black Cr0w, the logical operator is good to know)
OK, here's the deal...Word Macros don't exactly execute linearly.
I eventually figured out how to write an If/Then/Else statement that mostly worked. Mostly. It didn't actually check the condition until after it did a replace (wdReplaceOne). So it would change the first hyphen in a hyperlink and then go "oh, wait! This is a hyperlink!" and then it would skip any subsequent hyphens in that hyperlink.
So I ended up splitting my If/Then/Else into two separate If/Then blocks. The first one says "move along, nothing to do here," and the second one says, "aha! here's where we need a change." The code below, although cringe-worthy, does exactly what I want.
Sub replaceHyphens()
'
' Find hyphens that occur between digits and change them to en-dash, EXCEPT in hyperlinks
'
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "([0-9])-([0-9])"
.Forward = True
.Format = True
.Wrap = wdFindContinue
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute
End With
Do While (Selection.Find.Found = True)
If (Selection.Style = ActiveDocument.Styles("Hyperlink")) Then
Selection.Move Unit:=wdSentence, Count:=1
End If
Selection.Find.Execute
If (Selection.Style <> ActiveDocument.Styles("Hyperlink")) Then
Selection.Find.Replacement.Text = "\1" & Chr$(150) & "\2"
Selection.Find.Execute Replace:=wdReplaceOne
End If
Loop
End Sub
If anyone wants to suggest a cleaner way to do this, I'm all ears.
Thanks!

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

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

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