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)，然后删除找到的 textrange，直到找不到为止。代码是这样的：

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

删除Powerpoint VBA中的换行符

3 个答案: