ExcelVBA PowerPointのスライド／スライドマスターの表からテキストを取得したい。

Question

以前こちらで質問させていただいた者です。
ExcelVBAで指定フォルダ内の複数のPowerPointファイルを取得しその中から報告書Noを取得後、PDF変換して保存する処理をしています。
報告書Noの検索対象はPowerPointのスライド１ページ目内のテキストと全ページ？のスライドマスターにあるShapesも対象になります。

●GetText_ShapeObjectプロシージャ：Shapeオブジェクトの種類によってIF文で分岐し、テキストを取得
●Convert_PDF_PowerPointファンクション：PowerPointを開き、スライド1ページ目とスライドマスターのテキストに[報告書No]がある場合取得しPDF変換して閉じる

上記の２つの処理で行っているのですが、下記コード内の
パターンAの部分でShapesの種類が表の場合にテキスト取得をしようとしたら※１の部分で
「実行時エラー13　型が一致しません」と表示されます。

うまくいかないのでパターンBの構文でも取得しようとしても、※2の部分で
「実行時エラー438　オブジェクトはこのプロパティまたはメソッドをサポートしていません」とエラー表示されます。

パターンAとBはどちらかをコメントアウトしてそれぞれでエラーメッセージが表示されます。
他のShapesのテキストやHolderのテキストの値は取得できているし、表の列数や行数もデバッグで
確認したところ取得できていました。

どのように取得すればいいか教えていただきたいです。

'**********************************************************************************************************
' GetText_ShapeObject
'  　   スライド内のShapeオブジェクトからテキストがある場合取得
'　     CreateDate :2021/12/24　HIROKO.TODA
'       引数:PP_PathName…01フォルダパス
'       引数:SaveFilePath…02フォルダパス
'       引数:FlgConvPP…PDF変換完了フラグ
'**********************************************************************************************************
Public Sub GetText_ShapeObject(ByVal GetShape As Object, ByRef GetSText As Variant)
    Dim ShpClm As Columns
    Dim ShpCell As Cell
    Dim ShpArt As SmartArtNode
    Dim ShpGrp As GroupShapes
    Dim ColCount As Integer
    Dim RowCount As Integer

    If GetShape.HasTextFrame Then                               'テキストボックス、プレースホルダ、オートシェイプの場合

        GetSText = GetShape.TextFrame.TextRange.Text

    ElseIf GetShape.HasTable Then                               '表の場合
        

        
	'パターンA  
        For Each ShpClm In GetShape.Table.Columns		※１エラー※※　

            For Each ShpCell In ShpClm.Cells
                GetSText = ShpCell.Shape.TextFrame.TextRange.Text

            Next
        Next

  	'パターンB            
	'ColCount = GetShape.Table.Columns.Count		'列数は取得できている	
        'RowCount = GetShape.Table.Rows.Count  			'行数は取得できている
        
        For RowCount = 1 To GetShape.Table.Rows.Count
          For ColCount = 1 To GetShape.Table.Columns.Count
            
            GetSText = GetShape.Cell(RowCount, ColCount).TextFrame.TextRange.Text		※２エラー※※　
    
          Next ColCount
        Next RowCount
                
    ElseIf GetShape.HasChart Then                               'グラフの場合
         
        If GetShape.Chart.HasTitle Then GetSText = GetShape.Chart.Title
         
    ElseIf GetShape.HasSmartArt Then                            'スマートアートの場合
         
        For Each ShpArt In GetShape.SmartArt.Nodes
               
               GetSText = ShpArt.TextFrame2.TextRange.Text
        Next
    
    ElseIf GetShape.Type = msoGroup Then                        'グループの場合
         
        For Each ShpGrp In GetShape.GroupItems
             
             If ShpGrp.HasTextFrame Then GetSText = ShpGrp.TextFrame.TextRange.Text
        
        Next
    
    End If

End Sub



'**********************************************************************************************************
' Convert_PDF_PowerPoint
'  　   １フォルダにあるPowerPointファイルから報告書Noを取得しPowerPointに変換
'　     CreateDate :2021/11/30  HIROKO.TODA
'       引数:PP_PathName…01フォルダパス
'       引数:SaveFilePath…02フォルダパス
'       引数:FlgConvPP…PDF変換完了フラグ
'**********************************************************************************************************
Public Function Convert_PDF_PowerPoint(ByVal PP_PathName, SaveFilePath As String, ByRef FlgConvPP As Boolean) As String
    Dim ppApp As Object                             'PowerPoint.Application
    Dim ppPre As Object                             'PowerPoint.Presentation
    Dim ppSlide As Object                           'PowerPoint.Slide
    Dim ppShape As Object                           'PowerPoint.Shape
    Dim ppText As String                            'PowerPoint.Text
    Dim MustBreak As Boolean                        '報告書No取得フラグ
    Dim intSearch As Integer                        '検索結果返り値
    Dim intReportNoS As Integer
    Dim strReportNo As String
    Dim ppSMaster As Variant                        'PowerPointSlideMater
    Dim ppSMasterLayout As Variant                  'PowerPointSlideMaterCustomLayout
   
    '初期設定
    ppText = ""
   
    Application.ScreenUpdating = False
    
    Set ppApp = CreateObject("PowerPoint.Application")
    
    'PowerPointを起動する
    Set ppPre = ppApp.Presentations.Open(FileName:=PP_PathName, WithWindow:=MsoTriState.msoFalse)
　　　
	For Each ppSlide In ppPre.slides
    
        'スライド番号が１ページ目の場合に以下の処理を行う
        If ppSlide.SlideIndex = 1 Then
  
            '1ページ目のスライド内のShape分処理を繰り返す
            For Each ppShape In ppSlide.Shapes     
                ppText = ""
                
                'Shapeに含まれるテキストを取得
                Call GetText_ShapeObject(ppShape, ppText)

                If ppText <> "" Then
                
                    intSearch = InStr(ppText, ReportTitle)                                          'テキストに"報告書No."の開始位置を取得
                
                    If intSearch >= 1 Then                                                          '"報告書No."が含まれている場合 
                        intReportNoS = intSearch + 6                                                '報告書Noの取得開始位置を設定
                        strReportNo = Mid(ppText, intReportNoS)                                     '報告書Noを取得(取得したテキストの取得開始位置から11文字取得)
                        strReportNo = Replace(strReportNo, " ", "")                                 '取得した報告書Noから半角スペースを取り除く
                        strReportNo = Replace(strReportNo, "　", "")                                '取得した報告書Noから全角スペースを取り除く
                        Convert_PDF_PowerPoint = strReportNo                                        '関数の戻り値に報告書Noを返す
                        MustBreak = True                                                            '取得フラグをTrueにする
                    
                    End If
                    
                    If MustBreak Then Exit For                                                      '報告書Noを取得した場合は繰り返し処理から抜ける
                
                End If
            Next
        End If

        '１ページ目で報告書Noが取得できない場合に以下の処理を行う	
	If MustBreak = False Then
 
	　　'スライドマスターのShapesを指定
            For Each ppSMaster In ppSlide.master.Shapes                   
                ppText = ""
                
                'Shapeに含まれるテキストを取得
                Call GetText_ShapeObject(ppSMaster, ppText)
 
                ’’***報告書Noの取得をする(省略)***
                    MustBreak = True                                                        '取得フラグをTrueにする
                
                End If             
                If MustBreak Then Exit For                                                      '報告書Noを取得した場合は繰り返し処理から抜ける
                
            Next

	    'スライドマスターのCustomLayoutsを指定
            For Each ppSMasterLayout In ppSlide.master.CustomLayouts

                    
                For Each ppSMaster In ppSMasterLayout.Shapes
                    
                    ppText = ""
                        
                    'Shapeに含まれるテキストを取得
                    Call GetText_ShapeObject(ppSMaster, ppText)
                    
                　　’’***報告書Noの取得をする(省略)***
                    MustBreak = True                                                 '取得フラグをTrueにする
         
                    End If
                    
                    If MustBreak Then Exit For                                                  '報告書Noを取得した場合は繰り返し処理から抜ける
                
                Next
                
                If MustBreak Then Exit For                                                      '報告書Noを取得した場合は繰り返し処理から抜ける            
                
            Next          
                
       End If
	If MustBreak Then Exit For                                                     		'報告書Noを取得した場合は繰り返し処理から抜ける
    
    Next

    'PDF形式でファイルを保存する
    With ppPre
        .SaveAs FileName:=SaveFilePath, FileFormat:=32
    End With

    'Presentationを閉じる
    ppPre.Close
    
    'PDF変換完了フラグをTrueにする
    FlgConvPP = True
    
    'オブジェクトの開放
    Set ppShape = Nothing
    Set ppSlide = Nothing
    Set ppPre = Nothing
    Set ppApp = Nothing
    
    Application.ScreenUpdating = True

End Function

Answer 1

これでどうでしょうか。

GetSText = GetShape.Cell(RowCount, ColCount).Shape.TextFrame.TextRange.Text

Comments

[alma0925]

回答ありがとうございます。
質問したプログラムですが仕事で使用していまして、年明けに仕事で検証してからベストアンサーにしてもいいでしょうか？
お時間かかりますがよろしくお願い致します

[alma0925]

回答頂いたコードでテストしてみましたが、やはりエラーになったため、
Dim ShpClm As Columns
Dim ShpCell As Cell
の変数の型をVariant型にして対応致しました。
回答ありがとうございました。