Powerpointのシェイプ属性を再帰的にテキストファイルへ書き出す

単なるメモです。

Powerpointのシェイプ属性をテキストファイルへ書き出すVBAを修正し、いつもどこに置いたのかわからなくなるので、メモします。

PowerPointでオブジェクトを一覧にしてテキストファイルへ出力するで書いたシェイプ属性をテキストファイルとして書き出すソースが汎用性ないので再作成。シェイプをグループ化しても再帰的にグループ内シェイプを書き出すように修正。

Sub ExportShapes()

    Dim sld As Slide
    Dim shp As Shape
    Dim oTextFile As String
    Dim oRow As String
    oTextFile = ActivePresentation.Path & "\Shapes.txt"
    Open oTextFile For Output As #1

    Print #1, "スライド番号（階数）" & vbTab; "オブジェクト名" & vbTab & "属性"
    For Each sld In ActivePresentation.Slides
        If sld.SlideNumber <> 20 Then
            Call MainProc(sld, sld.SlideNumber)
        End If
    Next sld
    
    Close #1
    MsgBox "Shapes.txtに書き出しました。"
    
End Sub

Sub MainProc(ByVal sld As Slide, SlideNumber As Integer)

    For Each shp In sld.Shapes
        Call SubMainProc(shp, SlideNumber)
    Next shp

End Sub

Sub SubMainProc(ByVal shp As Shape, SlideNumber As Integer)
    
    'オートシェイプ
    If shp.Type = msoAutoShape Then
        oRow = SlideNumber & vbTab & shp.Name & vbTab & shp.TextFrame.TextRange.Text
        Print #1, oRow
    End If
    '線と画像
    If shp.Type <> msoGroup And shp.Type = msoLine Or shp.Type = msoPicture Then
        oRow = SlideNumber & vbTab & shp.Name & vbTab & ""
        Print #1, oRow
    End If

    If shp.Type = msoGroup Then
        oRow = SlideNumber & vbTab & shp.Name
        For Each gitem In shp.GroupItems
            Call SubMainProc(gitem, SlideNumber)
        Next gitem
    End If

End Sub