CODEWITHSUNDEEP
vbapowerpointstr-replace
user3328403
user3328403

Reputation: 3

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

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

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

Upvotes: 0

Views: 9143

Answers (3)

user7726756
user7726756

Reputation: 1

Easy,

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

to: 

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

Should do the trick.

Upvotes: 0

Steve Rindsberg
Steve Rindsberg

Reputation: 14809

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

Upvotes: 2

MLDev
MLDev

Reputation: 1277

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

Upvotes: 0

Related Questions