删除 Powerpoint VBA 中的换行符

Question

我看到了this post，但我无法修改我的 VBA 脚本以进行 PPT 演示。几乎每张幻灯片的文本框中都有文本。但是，在某些文本框的末尾有多个换行符（Enter hits），在某些地方大约有 1-3 个。我想要一个宏来删除那些不必要的换行符。告诉我我在这里做错了什么（2 个脚本）：

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

和

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 这种方式有点奇怪；行和段落结尾可能会有所不同，具体取决于您拥有的 PPT 版本以及形状是标题占位符还是其他类型的形状。

我在我维护的 PowerPoint 常见问题解答页面上有一个更详细的解释：

段落结尾和换行符 http://www.pptfaq.com/FAQ00992_Paragraph_endings_and_line_breaks.htm

Answer 2

令人沮丧的是，PPT VBA 有时无法在文本框中找到换行符。 TextRange.Text 或 TextRange.Runs 甚至 TextRange.Charaters 并不能帮助我们找到那些作为特殊用途的控制字符的中断。

在这种情况下，“TextRange.Find”是查找隐藏内容的有用解决方法。 如果要在文本框中查找和删除断点，请首先在其中的最后一个字符处找到任何 Chr(13)，然后删除找到的文本范围，直到找不到为止。代码如下：

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

当我在 PowerPoint 中按 Enter 时，它显然添加了一个垂直选项卡，其 ASCII 代码为 11。尝试以下操作：

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