PowerPointの使用中フォント集計マクロの解説

「PowerPointで使用しているフォントを集計するマクロを作ってみた」で作ったマクロの解説です。

PowerPointマクロの作り方

「新しいプレゼンテーション」でファイルを新規作成します。
まあ実際はなんでもいいのですが。
[Alt + F11]を押してVBE(Visual Basic Editor)を開きます。
[VBAProject (プレゼンテーション1)」を右クリック→「挿入」→「標準モジュール」をクリックします。
エディタ部分にマクロを書きます。
実行したいマクロにカーソルを合わせて[F5]で実行します。

マクロの解説

全てのスライドのすべてのオブジェクトを走査する

Private Sub checkAllSlides()
    Dim sld As Slide
    For Each sld In ActivePresentation.Slides
        Dim sh As Shape
        For Each sh In sld.Shapes
            ' shにオブジェクトが入ってくるので、それを使う
        Next
    Next
End Sub

テキストを持っているオブジェクトからテキストを取得する

プレイスホルダやオートシェイプなどのテキストを持っているオブジェクトからのテキストの取得方法です。
Shape::HasTextFrameでテキストの有無をチェックしてから、TextFrame.TextRange.Textで取得します。

    If sh.HasTextFrame Then
        Debug.Print sh.TextFrame.TextRange.Text
    End If

グラフからテキストを取得する

グラフの各場所のテキストの取得方法です。
Shape::TypeがmsoChartの場合、またはShape::HasChartがTrueの場合がグラフのはずなので、その場合にタイトル、凡例、軸のタイトル、軸のテキストを取得します。

    If sh.Type = msoChart Or sh.HasChart Then
        Dim txt
        ' タイトル
        If sh.Chart.HasTitle Then
            Debug.Print sh.Chart.ChartTitle.Text
        End If
    
        ' 凡例
        If sh.Chart.HasLegend Then
            For Each txt In sh.Chart.SeriesCollection
                Debug.Print txt.Name
            Next
        End If

        ' X軸Y軸
        Dim ax
        For Each ax In sh.Chart.Axes
            ' 軸のタイトル
            If ax.HasTitle Then
                Debug.Print ax.AxisTitle.Text
            End If
            
            '-------------
            ' 軸のテキスト
            '-------------
            ' 項目軸 or 系列軸(3Dグラフのみ)
            If ax.Type = XlAxisType.xlCategory Or _
               ax.Type = XlAxisType.xlSeriesAxis Then
                For Each txt In ax.CategoryNames
                    Debug.Print txt
                Next
                
            ' 数値軸
            ElseIf ax.Type = XlAxisType.xlValue Then
                Dim num As Double
                For num = ax.MinimumScale To ax.MaximumScale Step ax.MajorUnit
                    Debug.Print num
                Next
            End If
        Next
    End If

表からテキストを取得する

表のテキストの取得方法です。
Shape::TypeがmsoTableの場合、またはShape::HasTableがTrueの場合が表のはずなので、その場合に各セルのテキストを取得します。

    If sh.Type = msoTable Or sh.HasTable Then
        Dim col As Column
        Dim c As Cell
        For Each col In sh.Table.Columns
            For Each c In col.Cells
                Debug.Print c.Shape.TextFrame.TextRange.Text
            Next
        Next 
    End If

スマートアートからテキストを取得する

スマートアートからのテキストの取得方法です。
Shape::TypeがmsoSmartArtの場合、またはShape::HasSmartArtがTrueの場合がスマートアートのはずなので、その場合に各ノードのテキストを取得します。
ただし、PowerPoint2010以降にしかHasSmartArtメソッドが無いため、バージョン確認後に詳細をチェックします。

' こっちがチェックしてテキストを取得する処理
    If checkHasSmartArt(sh) Then
        Dim n As SmartArtNode
        For Each n In sh.SmartArt.Nodes
            Debug.Print n.TextFrame2.TextRange.Text
        Next
    End If

' こっちがチェックするための関数
' shの型をShapeに固定するとPowerPoint2010以前でエラーになるので型指定しない
Private Function checkHasSmartArt(sh) As Boolean
    checkHasSmartArt = False
    ' PowerPoint 2010以降のみ
    If Application.Version >= 15 Then
        If sh.Type = msoSmartArt Or sh.HasSmartArt Then
            checkHasSmartArt = True
        End If
    End If
End Function

グループ化されているオブジェクトからテキストを取得する

グループ化されている場合は、グループ内の各オブジェクトに対して再帰的にテキストを取得します。Shape::TypeがmsoGroupの場合がグループです。

    If sh.Type = msoGroup Then
        Dim groupSh As Shape
        For Each groupSh In sh.GroupItems
            ' groupShに対して、再度テキスト取得処理を行う。
        Next
    End If

PowerPointからExcelを操作する

CreateObjectでExcel.Applicationを生成すれば、あとは自由自在です。

    ' Excelの生成
    Dim xlApp
    Set xlApp = CreateObject("Excel.Application")
    ' 画面に表示
    xlApp.Visible = True
    
    ' 新規ワークブック生成
    xlApp.Workbooks.Add

    ' セルを変更
    xlApp.Workbooks(1).Worksheets(1).Cells(1, 1) = "Test"

    ' Excelを解放
    Set xlApp = Nothing

Mantalog

～ blog of the Mantarou, by the Mantarou, for the Mantarou ～