将 PowerPoint 中的 table 文本替换为 Excel VBA,保留 PowerPoint 格式

Replace table text in PowerPoint from Excel VBA, preserve PowerPoint formatting

我正在尝试替换 PowerPoint table 中的文本,同时保留现有的 PowerPoint table 格式。

不幸的是,我已经找到了这样做的方法。当我 运行 下面的代码时,所有 PowerPoint table 文本都恢复为 14 号。我想在每个 table 中保留不同的文本大小,甚至在每个文本元素中(例如,某些文本元素之后的脚注)。

请在下面找到我的代码。


Sub UpdatePresentation()
Dim i As Long, FindWord As String, ReplaceWord As String, cell As Range
Dim path As String
Dim pres As String
Dim PPT As Object

Set PPT = CreateObject("PowerPoint.Application")
path = "Dashboard Template.pptx"
PPT.Presentations.Open Filename:=path

For Each cell In wsDashboard.Range("E6:F35")
    If cell.Value2 <> "" Then
            FindWord = cell.Text

        ReplaceWord = cell.Offset(0, 2).Text
            
        
        Debug.Print (FindWord & " " & ReplaceWord)
        Call ReplacePresentationText(pres, FindWord, ReplaceWord)
    Else
        'do nothing
    
    End If
Next cell

End Sub

Function ReplacePresentationText(ByRef PPTPres As Variant, ByVal FindWord As Variant, ByVal ReplaceWord As Variant) As Variant
Dim sld As Object, shp As Object, ShpText As Object, TempText As Object

    For Each sld In PPTPres.slides
        For Each shp In sld.Shapes            
            If shp.Hastable Then
                For i = 1 To shp.Table.Rows.Count
                    For j = 1 To shp.Table.Columns.Count
'                        shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Text = _
'                    Replace(shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Text, FindWord, ReplaceWord) ''USED THIS CODE TO REPLACE THE TEXT FIRST

                    shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Paragraphs(p).Text = _
                    Replace(shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Paragraphs(p).Text, FindWord, ReplaceWord)

                Next j
            Next i

            End If
        Next shp
    Next sld

End Function


不要替换 .Text 属性,而是在文本容器上使用 .Replace 方法,例如:

.TextFrame.TextRange.Paragraphs(x).Replace TextToReplace, TextToReplaceItWith