Remove Line Break in Powerpoint VBA

Question

I saw this post but I couldn't modify my VBA script for PPT presentation. Almost each slide has text in textbox. However, at the end of some textboxes there are multiple line breaks at the end (Enter hits), about 1-3 in some places. I would like to have a macro to delete those uneccessary line breaks. Tell me what I'm doing wrong here (2 scripts):

Sub RemoveSpaces(osh As Shape)

Dim oSl As Slide
    Dim osh As Shape


    With ActivePresentation

For Each oSl In .Slides
    For Each osh In oSl.Shapes
        With osh
            If .HasTextFrame Then
                If .TextFrame.HasText Then
                    If Right$(osh.TextFrame.TextRange.Characters(osh.TextFrame.TextRange.Length, 2)) = vbCrLf Then
                    osh.TextFrame.TextRange.Text = Left$(osh.TextFrame.TextRange.Text, Len(osh.TextFrame.TextRange.Text) - 2)
                    End If
                End If
            End If
        End With
    Next
Next

    End With
End Sub

and

Sub RemoveSpaces()

Dim oSl As Slide
    Dim osh As Shape


    With ActivePresentation

For Each oSl In .Slides
    For Each osh In oSl.Shapes
        With osh
            If .HasTextFrame Then
                If .TextFrame.HasText Then
                    If osh.TextFrame.TextRange.Characters(osh.TextFrame.TextRange.Length - 2, 2).Text = vbCrLf Then
                    osh.TextFrame.TextRange.Characters(osh.TextFrame.TextRange.Length - 2, 2).Delete
                    End If
                End If
            End If
        End With
    Next
Next

    End With
End Sub

Answer 1

Powerpoint's a bit weird this way; line and paragraph endings may vary depending on the version of PPT you have and on whether the shape is a title placeholder or some other type of shape.

I've got a page on the PowerPoint FAQ I maintain that explains in more detail:

Paragraph endings and line breaks http://www.pptfaq.com/FAQ00992_Paragraph_endings_and_line_breaks.htm

Answer 2

It is so frustrating that PPT VBA sometimes fails to find a Line/Paragraph break in a text box. TextRange.Text or TextRange.Runs or even TextRange.Charaters doesn't help us find those breaks which are control characters for special purpose.

In this case, 'TextRange.Find' is a useful workaround to find something hidden. If you want to find and delete breaks in a text box, first find any Chr(13) at the last character in it and then delete the found textrange until not found. The code goes like this:

Sub RemoveBreaks()

Dim oSl As Slide
Dim osh As Shape
Dim tr As TextRange

With ActivePresentation

    For Each oSl In ActiveWindow.Selection.SlideRange     '.Slides
        For Each osh In oSl.Shapes
            With osh
                If .HasTextFrame Then
                    If .TextFrame.HasText Then
                    
                        With .TextFrame.TextRange
                            Do
                                Set tr = Nothing
                                Set tr = .Find(Chr(13), .Length - 1, 1)
                                If Not tr Is Nothing Then
                                    
                                    Debug.Print "Found <BR> in " & osh.Name & _
                                       " on Slide #" & oSl.SlideIndex
                                    tr.Delete
                                    
                                End If
                            Loop While Not tr Is Nothing
                        End With
                        
                    End If
                End If
            End With
        Next
    Next

End With
End Sub

Answer 3

When I press enter in PowerPoint, it apparently adds a Vertical Tab which is ASCII code of 11. Try the following:

Sub RemoveSpaces()

Dim oSl As Slide
    Dim osh As Shape


    With ActivePresentation

For Each oSl In .Slides
    For Each osh In oSl.Shapes
        With osh
            If .HasTextFrame Then
                If .TextFrame.HasText Then
                    Do While osh.TextFrame.TextRange.Characters(osh.TextFrame.TextRange.Length - 1, 1).Text = Chr(11)
                        osh.TextFrame.TextRange.Characters(osh.TextFrame.TextRange.Length - 1, 1).Delete
                    Loop
                End If
            End If
        End With
    Next
Next

    End With
End Sub