以編程方式編輯 PowerPoint 演示文稿中的文本

Question

我需要編寫一個程序，該程序可以遍歷演示文稿並將文本字符串的所有實例更改為不同的實例。 因此，例如，無論何時出現文本字符串“舊公司名稱”，它都會將其替換為“新公司名稱”。

我對如何自動化 Powerpoint 有了大致的了解，挑戰在於很難遍歷 shape 對象，而且我看不到存儲此數據的明顯屬性（例如，“文本”屬性。）

有人可以指出我正確的方向嗎？

另外，有沒有一個工具可以更容易地挖掘Office產品的對象模型，也就是說遍歷特定文檔的實例對象樹？ 通常我會用 Visual Studio 調試器來做這件事，但因為它是 COM 之上的一個薄層，你不能像在其他情況下那樣在監視窗口中輕松地遍歷對象實例樹。 有沒有好的工具可以幫助解決這個問題？

PPT 2010 如果重要的話。

Answer 1

Powerpoint 是自動化（使用 VBA）的更棘手的 Office 應用程序之一，因為您無法像使用 Word 和 Excel 那樣錄制宏。 我發現學習對象模型的最佳方法是將 Web 搜索和對象瀏覽器與 VBIDE（只需按 F2）相結合。

至於文本替換，一旦你知道，這是一個簡單的例子。 您可以循環瀏覽特定幻燈片中的所有形狀，然后檢查該形狀的文本。 （請注意，此代碼實際上來自 Excel 工作簿，因此它包含Powerpoint中不需要的Powerpoint引用：

編輯：史蒂夫對原始編輯僅搜索文本框提出了一個很好的觀點，根據您的演示設置，您必須單獨對每種類型的對象進行排序，並對每種類型實施自定義替換。 不是特別困難，只是背部疼痛。

另請注意，根據演示文稿的大小，循環瀏覽所有形狀可能需要一段時間。 我還使用了.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