以编程方式编辑 PowerPoint 演示文稿中的文本

Question

我需要编写一个程序，它可以遍历演示文稿并将文本字符串的所有实例更改为不同的实例。因此，例如，无论何时出现文本字符串“旧公司名称”，它都会将其替换为“新公司名称”。

我大致了解如何自动化 Powerpoint，挑战在于很难遍历形状对象，而且我看不到存储此数据的明显属性（例如，“文本”财产。）

有人能指出正确的方向吗？

另外，有没有一种工具可以更容易地挖掘 Office 产品的对象模型，即遍历特定文档的实例对象树？通常我会使用 Visual Studio 调试器来执行此操作，但因为它是 COM 之上的一个薄层，所以您不能像在其他情况下那样轻松地在监视窗口中遍历对象实例树。有什么好的工具可以帮助解决这个问题吗？

PPT 2010 如果重要的话。

Answer 1

Powerpoint 是自动化（使用 VBA）较为棘手的 Office 应用程序之一，因为您无法像使用 Word 和 Excel 那样记录宏。我发现学习对象模型的最佳方法是将 Web 搜索和对象浏览器与 VBIDE 相结合（只需按 F2）。

至于文字替换，你知道就简单了。您可以循环浏览特定幻灯片中的所有形状，然后检查该形状的文本。 （请注意，此代码实际上来自 Excel 工作簿，因此它具有 Powerpoint 引用，这在 Powerpoint 中是不需要的：

编辑：Steve 提出了一个非常好的观点，即原始编辑仅搜索文本框，根据您的演示设置，您必须单独对每种类型的对象进行排序并实现自定义替换每种类型。不是特别难，只是后背疼。

另请注意，根据演示文稿的大小，循环浏览所有形状可能需要一段时间。我还使用了.HasTextFrame/.HasTable 和.Type 的组合，所以你可以看到这两种类型。

Sub ReplaceTextShape(sFindText As String, sNewText As String, ppOnSlide As PowerPoint.Slide)
    Dim ppCurShape As PowerPoint.Shape

    For Each ppCurShape In ppOnSlide.Shapes
        If ppCurShape.HasTextFrame Then
            ppCurShape.TextFrame.TextRange.Text = VBA.Replace(ppCurShape.TextFrame.TextRange.Text, sFindText, sNewText)
        ElseIf ppCurShape.HasTable Then
            Call FindTextinPPTables(ppCurShape.Table, sFindText, sNewText)
        ElseIf ppCurShape.Type = msoGroup Then
            Call FindTextinPPShapeGroup(ppCurShape, sFindText, sNewText)
            ''Note you'll have to implement this function, it is an example only
        ElseIf ppCurShape.Type = msoSmartArt Then
            Call FindTextinPPSmartArt(ppCurShape, sFindText, sNewText)
            ''Note you'll have to implement this function, it is an example only
        ElseIf ppCurShape.Type = msoCallout Then
            'etc
        ElseIf ppCurShape.Type = msoComment Then
            'etc etc
        End If
    Next ppCurShape

    Set ppCurShape = Nothing
End Sub

然后替换整个演示文稿中的所有文本：

Sub ReplaceAllText(ppPres As PowerPoint.Presentation)
    Dim ppSlide As PowerPoint.Slide

    For Each ppSlide In ppPres.Slides
        Call ReplaceTextShape("Hello", "Goodbye", ppSlide)
    Next ppSlide

    Set ppSlide = Nothing
End Sub

以及替换表格中文本的示例代码：

Sub FindTextinPPTables(ppTable As PowerPoint.Table, sFindText As String, sReplaceText As String)
    Dim iRows As Integer, iCols As Integer

    With ppTable
        iRows = .Rows.Count
        iCols = .Columns.Count

        For ii = 1 To iRows
            For jj = 1 To iCols
                .Cell(ii, jj).Shape.TextFrame.TextRange.Text = VBA.Replace(.Cell(ii, jj).Shape.TextFrame.TextRange.Text, sFindText, sReplaceText)
            Next jj
        Next ii
    End With

End Sub