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.