VBA code to skip bullet items

[SOB]

Hello,

I have written a macro for MS Word to replace any instance of two paragraphs returns with one paragraph return. (Double paragraph returns cause problems later on in the production cycle at the publication I work for.) Here's the code:


Sub ReplaceDoubleReturnsWithSingleReturn()


Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub




While this code works in general, it has the following bug. If the last item of a bulleted list in the document is hyperlinked, running the macro causes that item to get deleted. I've attached a test document so that you can see what I mean. The highlighted word in the doc gets deleted after you run the macro.

Is it possible to add code that prevents the macro from replacing returns around bulleted text?

I'm only an amateur VBA user, and basically just pieced together bits of code I found online to make my macro. So not an expert here. Any help is much appreciated! Thanks.

====

Word for Mac 2011 - Version 14.5.1

[macropod]

I am unable to reproduce the reported behaviour - the last bulleted item in your document is preserved (as is the hyperlink).

[SOB]

Oh, I uploaded the wrong test document. Could you take one more look using the newly attached file titled "Word test doc_with error"? Thanks.

[macropod]

The problem with your latest attachment is that you have made the paragraph breaks part of the hyperlink display text, which they should not be. Fix that and the problem will go away.

[SOB]

Ah, that's the problem. So, I have a team of editors running this script on all sorts of documents. Which means I need to create some VBA code that removes any paragraph breaks from hyperlink display text.

I tried the following code, but it didn't fix the problem, I think because it's modifying the actual hyperlink, not the hyperlink display text:


Sub HyperLinkChange()


Dim oldtext As String, newtext As String
Dim h As Hyperlink


oldtext = "^p"
newtext = ""


For Each h In ActiveDocument.Hyperlinks
If InStr(1, h.Address, oldtext) Then
If h.TextToDisplay = h.Address Then
h.TextToDisplay = newtext
End If
h.Address = Replace(h.Address, oldtext, newtext)
End If
Next
End Sub


Do you have any suggestions on how I can use VBA to remove any paragraph breaks from hyperlink display text?

[macropod]

Try the following:

Sub Demo()
Dim Hlnk As Hyperlink
For Each Hlnk In ActiveDocument.Hyperlinks
With Hlnk
If .Range.Characters.Last = vbCr Then
.Range.InsertAfter vbCr
If .Range.Paragraphs.First.Range.ParagraphStyle = .Range.Paragraphs.First.Previous.Range.ParagraphStyle Then
.Range.Characters.Last.Next.FormattedText = .Range.Paragraphs.First.Previous.Range.Characters.Last.FormattedText
End If
.TextToDisplay = Split(.Range.Text, vbCr)(0)
.Range.Style = wdStyleHyperlink
End If
End With
Next
End Sub

[SOB]

Awesome, thanks so much. At first it gave me a compile error stating “Method or data member not found” that highlights “ParagraphStyle” in the phrase “.Range.Paragraphs.First.Range.ParagraphStyle”. But after I changed ".ParagraphStyle" to just ".Style", it worked fine.

Final code I used:


Sub Demo()
Dim Hlnk As Hyperlink
For Each Hlnk In ActiveDocument.Hyperlinks
With Hlnk
If .Range.Characters.Last = vbCr Then
.Range.InsertAfter vbCr
If .Range.Paragraphs.First.Range.Style = .Range.Paragraphs.First.Previous.Range.Style Then
.Range.Characters.Last.Next.FormattedText = .Range.Paragraphs.First.Previous.Range.Characters.Last.FormattedText
End If
.TextToDisplay = Split(.Range.Text, vbCr)(0)
.Range.Style = wdStyleHyperlink
End If
End With
Next
End Sub


Thanks again!

[macropod]

If ParagraphStyle doesn't work for you, that suggests you're still using Word 2003 or earlier.