0

我试图在保留现有 PowerPoint 表格格式的同时替换 PowerPoint 表格中的文本。

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

请在下面找到我的代码。


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
4

1 回答 1

2

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

.TextFrame.TextRange.Paragraphs(x).Replace TextToReplace, TextToReplaceItWith
于 2020-12-08T16:46:24.757 回答