如何使用 VBA 替换包括表格在内的整个 PowerPoint 中的单词？

How do I replace words in entire powerpoint including tables using VBA?

提问by user3328403

I have to go through numerous powerpoints replacing specific words with new ones. I made a macro that seemed to work, however after closer examination I realized that words within tables were not being replaced. After some searching I saw other people having this issue but no clear answer. I came up with the following but I also get the runtime error "This member can only be accessed for a group" on the line that reads For Each grpItem In shp.GroupItems

我必须通过大量的powerpoints 用新的词替换特定的词。我制作了一个似乎有效的宏，但是经过仔细检查后，我意识到表格中的单词没有被替换。经过一番搜索，我看到其他人有这个问题，但没有明确的答案。我想出了以下内容，但我也在读取的行上收到运行时错误“此成员只能为组访问”For Each grpItem In shp.GroupItems

Could someone provide insight as to what I'm doing wrong, or perhaps a better way to do this?

有人可以提供有关我做错了什么的见解，或者更好的方法吗？

 Sub DataScrubAllSlidesAndTables()
    Dim sld As Slide
    Dim grpItem As Shape
    Dim shp As Shape

For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes

        If shp.HasTextFrame Then
            If shp.TextFrame.HasText Then
                shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "Store", "Seller")
                shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "Customer", "Buyer")
            End If
        End If

        If shp.Type = msoTable Then
                For Each grpItem In shp.GroupItems
                    If InStr(1, grpItem.Name, "Rectangle") Then
                        grpItem.TextFrame.TextRange.Text = Replace(grpItem.TextFrame.TextRange.Text, "Store", "Seller")
                        grpItem.TextFrame.TextRange.Text = Replace(grpItem.TextFrame.TextRange.Text, "Store", "Seller")
                    End If
                Next grpItem
        End If

    Next shp
Next
End Sub

回答by Steve Rindsberg

This:

这个：

 Sub DataScrubAllSlidesAndTables()
    Dim sld As Slide
    Dim grpItem As Shape
    Dim shp As Shape
    Dim i As Long
    Dim j As Long

    For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes

        If shp.HasTextFrame Then
            If shp.TextFrame.HasText Then
                shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "Store", "Seller")
                shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "Customer", "Buyer")
            End If
        End If

        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, "This", "That")
                Next j
            Next i
        End If

    Next shp
Next
End Sub

回答by user7726756

Easy,

简单，

These 2 lines need to change from: Dim grpItem As Shape Dim shp As Shape

这 2 行需要更改为： Dim grpItem As Shape Dim shp As Shape

to:

到：

Dim grpItem As Powerpoint.Shape
Dim shp As Powerpoint.Shape

Should do the trick.

应该做的伎俩。

回答by Pedrumj

try using this:

尝试使用这个：

 Sub DataScrubAllSlidesAndTables()
    Dim sld As Slide
    Dim grpItem As Shape
    Dim shp As Shape
    Dim i As Integer
    Dim j As Integer
    Dim varTemp As Variant
    For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes

        If shp.HasTextFrame Then
            If shp.TextFrame.HasText Then
                shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "Store", "Seller")
                shp.TextFrame.TextRange.Text = Replace(shp.TextFrame.TextRange.Text, "Customer", "Buyer")
            End If
        End If

        On Error GoTo lblNotTable:
        For i = 1 To shp.Table.Rows.Count
            For j = 1 To shp.Table.Columns.Count
            varTemp = shp.Table.Rows.Item(i).Cells(j).Shape.TextFrame.TextRange.Text
            Next j
        Next i
lblNotTable:
        Err.Clear


    Next shp
Next
End Sub