【パワポVBA】オブジェクト数・画像数を数えるマクロ

PowerPoint VBAでパワポアートで使用したオブジェクト数を数える「PPTオブジェクト数カウンター」を作りました。

SNS投稿時にイラストを全選択したキャプチャの横にオブジェクト数を添えることができます。

画像数だけを数えるマクロも追加しました。

この記事の目次

オブジェクト数を数えるマクロ
1. コード
2. 実行結果
画像数を数えるマクロ

オブジェクト数を数えるマクロ

コード

Sub PPTオブジェクト数カウンター()

    Dim n As Long
    Dim shpNum As Long
    
    '選択中のスライド番号を取得
    n = ActiveWindow.Selection.SlideRange.SlideIndex
    
    'オブジェクト数を数える
    shpNum = ActivePresentation.Slides.Item(n).Shapes.Count
    
    'オブジェクト数を表示
    MsgBox "オブジェクト数は「 " & shpNum & " 」個です。"

End Sub

すべてのグループ化を解除してから実行します。グループ化されていると、1つのグループで1個とカウントされてしまいます。

実行結果

オブジェクト数を数えたいスライドを選択して実行します。

コロシテくんのオブジェクト数は「22」個です。

オブジェクトをすべて選択してから実行することも可能です。

カウンターはドラッグ＆ドロップで好きな場所に移動できます。

パワポアートを描いたらオブジェクト数入りのキャプチャを撮って、TwitterやInstagramでハッシュタグ「#pptart」をつけて投稿してみよう！

画像数を数えるマクロ

すべてのスライドの画像数を数えるマクロです。

Sub CountImages()

    '変数の宣言
    Dim sld As Slide 'スライド
    Dim shp As shape '図形
    Dim count As Integer '画像の数

    '初期化
    count = 0

    'すべてのスライドに対して処理を行う
    For Each sld In ActivePresentation.Slides

        'スライド内のすべての図形に対して処理を行う
        For Each shp In sld.Shapes

            '図形が画像である場合
            If shp.Type = msoPicture Then

                '画像の数を増やす
                count = count + 1

            End If
        Next shp
    Next sld

    '結果をメッセージボックスで表示
    MsgBox "画像の数: " & count

End Sub