VBAでパワポ操作

    Option Explicit
    
    
    '  汎用変数
      Dim flg As Boolean
      Dim path As String
      Dim rng As Range
      Dim celary() As Variant
      Dim ary() As Variant
    
    '  book,sheet変数
      Dim wb As Workbook
      Dim ws As Worksheet
      Dim wbdata As Workbook
      Dim wsdata As Worksheet
    
    
    Sub main()
      
    '  汎用変数
      Dim i As Long, k As Long, j As Long
    
    '  book,sheet変数設定
      Set wb = ThisWorkbook
      Set ws = wb.Worksheets("ツール")
      path = ws.Range("_filepath")
      Set wbdata = Workbooks.Open(path)
      path = ws.Range("_wsname")
      Set wsdata = wbdata.Worksheets(path)
    
      
    '  位置変数
      Dim row_codeSt As Long
      Dim row_codeEd As Long
      Dim col_code As Long
    
    '  配列変数
      Dim ary_code() As Variant
    
      
      celary = wsdata.Range(wsdata.Cells(1, 1), wsdata.Cells(100, 100))
      For i = 1 To 100
        For k = 1 To 100
          If celary(i, k) = "codename" Then
            Set rng = wsdata.Cells(i, k)
          End If
        Next
      Next i
      row_codeSt = rng.Row
      col_code = rng.Column
      row_codeEd = wsdata.Cells(Rows.Count, col_code).End(xlUp).Row
      
      ary_code() = wsdata.Range(wsdata.Cells(row_codeSt + 1, col_code), wsdata.Cells(row_codeEd, col_code + 1))
      For i = 1 To UBound(ary_code, 1)
        ary_code(i, 2) = ""
      Next i
      
    '  PwoerPoint
      Dim ppApp As New PowerPoint.Application
      Dim ppPt As Presentation
      Dim ppSlide As Slide
      Dim sh As PowerPoint.Shape
      Dim ppShape As PowerPoint.Shape
      
      
      Set ppPt = ppApp.Presentations.Open(ws.Range("_ppfilepath"))
    '  Set ppPt = ppApp.ActivePresentation
      
      For i = ws.Range("_slidestart").Value To ws.Range("_slideend").Value Step 1
          Set ppSlide = ppPt.Slides(i)
          Call PowerPointDataCheckAndDelete(ary_code, ppSlide)
          
          For k = 1 To UBound(ary_code, 1)
            If ary_code(k, 2) = 1 Then
              wsdata.Cells(row_codeSt + k, col_code).Interior.Color = RGB(204, 126, 177)
            End If
          Next k
          
      Next i
    
    End Sub
    
    
    Sub PowerPointDataCheckAndDelete(ByRef ary_code, ByVal ppSld As Slide)
    
      Dim i As Long, j As Long, k As Long
      
      Dim rg As New RegExp
    
      Dim col As Long
      col = ws.Range("_検索列").Value
    
      Dim ppSh As PowerPoint.Shape
      Dim ary_cnt() As Variant
    
      For Each ppSh In ppSld.Shapes
        If ppSh.Type = msoTable Then
          ReDim ary(ppSh.Table.Rows.Count)
          For i = 1 To ppSh.Table.Rows.Count
            ary(i) = ppSh.Table.Cell(i, col).Shape.TextFrame.TextRange
          Next i
          
          rg.Global = True
          rg.Pattern = "[\s]"
          
          j = 0
          For i = 1 To UBound(ary)
            For k = 1 To UBound(ary_code, 1)
              If rg.Replace(ary(i), "") = rg.Replace(ary_code(k, 1), "") Then
                ary_code(k, 2) = 1
                ReDim Preserve ary_cnt(j)
                ary_cnt(j) = i
                j = j + 1
              End If
            Next k
          Next i
          
    
          For k = ppSh.Table.Rows.Count To 1 Step -1
          flg = False
            For i = 0 To UBound(ary_cnt)
              If k = ary_cnt(i) Then
                flg = True
              End If
            Next i
            If flg = False Then
              ppSh.Table.Rows(k).Delete
            End If
          Next k
          
        End If
     
      Next ppSh
    
    End Sub