パワーポイントのオブジェクト(図形)を便利に操作する方法をマクロを使ってコマンド作ってみた

　会社内の報告会や研究の発表会など誰にかに説明をするときにMicrosoft Officeのパワーポイントで資料を作成する機会があるかと思います。人に伝えたいことをオブジェクト(図形)を使って視覚的な表現を利用することでより効果的なプレゼンテーションができます。しかし、オブジェクトの配置や大きさなどの細かな調整に時間がかかってしまい、資料作成に膨大なコストがかかってしまうことが良くあります。私も報告書を作成する際に細かいオブジェクトの調整をした挙句、上手くいかず修正前のスライドに戻すなんてことがよくありました。時短や見栄えのためにパワーポイントの標準で用意されている機能を使っていますが、もっと〇〇できたらいいのにな～と思うことが多々ありました。

　そこで今回はもっと〇〇できたらいいな～と思った内容をパワーポイントのマクロを使ってコマンドを作ってみました。まだ開発途中ではありますが、使えると思ったコマンドを中心に本ページで綴っていきます。

　さらに一般的にパワーポイントのマクロは「.pptm」ファイルで保存されます。そしてそのファイルにマクロが仕込まれており、マクロは当該ファイル上でしか動きません。せっかく業務効率化のために作ったマクロが制限されてしまってはもったいないので、作成したマクロをコマンドに埋め込むことでどのパワーポイントのファイルでもコマンド（マクロ）を動かせるような設定まで今回ご紹介します。少しでも皆さんのパワーポイントにかかるコストが下がることを祈っています。

パワーポイント標準の便利なコマンド
マクロを使ったオブジェクトの便利コマンド
作成したマクロをパワーポイントで共通的に利用できるようにする
まとめ

パワーポイント標準の便利なコマンド

まずはパワーポイントの標準で用意されている便利なコマンドについて紹介します。「ホーム」のリボンにある「配置」に下記コマンドが用意されています。

上に整列させる
選択したオブジェクトの一番上のオブジェクトに揃うように上側に整列します

左に整列させる
選択したオブジェクトの一番左のオブジェクトに揃うように左側に整理します

左右中央に整列させる
選択したオブジェクト間の左右中心にオブジェクトが揃うように整列します

上下中央に整列させる
選択したオブジェクト間の上下中心にオブジェクトが揃うように整列します

オブジェクトの左右間隔を均等にして整列する
選択したオブジェクトの左端および右端を横幅として間隔を均等にして左右に整列します

オブジェクトの上下間隔を均等にして整列する
選択したオブジェクトの上端および下端を縦幅として間隔を均等にして上下に整列します

マクロを使ったオブジェクトの便利コマンド

先述したパワーポイントの標準コマンドだけではどうしても作りたい絵や図形の作成に時間がかかってしまいます。そこで標準コマンドから拡張して独自でマクロを作りました。使えそうなコマンドをここでは紹介します。また実際のマクロのスクリプトも公開しますので、ぜひ使ってみてください。

大きさをぴったり揃える
選択したオブジェクトの縦横の大きさをぴったりと揃える

実際のマクロは次の通りです。ポイントは最初に選択したオブジェクトの高さと横幅になるように他のオブジェクトの大きさが統一になります。軸となるオブジェクトを最初に選択するように注意してください。パワーポイントで利用する時はマウスでコントロールボタンを押しながらオブジェクトを複数選択してください。

Sub EqualizeWidthHeight()
    Dim shp As Shape
    Dim targetWidth As Single
    
    ' 最初の図形の幅を基準とする
    targetWidth = ActiveWindow.Selection.ShapeRange(1).Width
    targetHeight = ActiveWindow.Selection.ShapeRange(1).Height
    
    ' 選択された図形をすべて同じ幅にする
    For Each shp In ActiveWindow.Selection.ShapeRange
        shp.Width = targetWidth
        shp.Height = targetHeight
    Next shp
End Sub

Sub EqualizeWidthHeight()

Dim shp As Shape

Dim targetWidth As Single

' 最初の図形の幅を基準とする

targetWidth = ActiveWindow.Selection.ShapeRange(1).Width

targetHeight = ActiveWindow.Selection.ShapeRange(1).Height

' 選択された図形をすべて同じ幅にする

For Each shp In ActiveWindow.Selection.ShapeRange

shp.Width = targetWidth

shp.Height = targetHeight

Next shp

End Sub

ぴったり横に並べる
選択したオブジェクトを横にぴったりと順番に並べる

実際のマクロは次の通りです。ポイントは最初に選択したオブジェクトを軸に選択された複数のオブジェクトをぴったりと順番に横に並べます。

Sub ArrangeShapesHorizontally()
    Dim selectedShapes As ShapeRange
    Dim baseShape As Shape
    Dim currentLeft As Single
    Dim i As Integer
    
    ' 選択されている図形を取得
    If ActiveWindow.Selection.Type = ppSelectionShapes Then
        Set selectedShapes = ActiveWindow.Selection.ShapeRange
        
        ' 選択された図形が2つ以上必要
        If selectedShapes.Count < 2 Then
            MsgBox "図形を2つ以上選択してください。"
            Exit Sub
        End If
        
        ' 最初の図形を基準に設定
        Set baseShape = selectedShapes(1)
        currentLeft = baseShape.Left + baseShape.Width
        
        ' 2番目以降の図形を基準図形の右側に配置
        For i = 2 To selectedShapes.Count
            With selectedShapes(i)
                .Left = currentLeft
                .Top = baseShape.Top ' 基準図形の高さに揃える
                currentLeft = .Left + .Width ' 次の図形の配置位置を計算
            End With
        Next i
        
        ' MsgBox "図形を水平に並べました。"
    Else
        ' MsgBox "図形を選択してください。"
    End If
End Sub

Sub ArrangeShapesHorizontally()

Dim selectedShapes As ShapeRange

Dim baseShape As Shape

Dim currentLeft As Single

Dim i As Integer

' 選択されている図形を取得

If ActiveWindow.Selection.Type = ppSelectionShapes Then

Set selectedShapes = ActiveWindow.Selection.ShapeRange

' 選択された図形が2つ以上必要

If selectedShapes.Count < 2 Then

MsgBox "図形を2つ以上選択してください。"

Exit Sub

End If

' 最初の図形を基準に設定

Set baseShape = selectedShapes(1)

currentLeft = baseShape.Left + baseShape.Width

' 2番目以降の図形を基準図形の右側に配置

For i = 2 To selectedShapes.Count

With selectedShapes(i)

.Left = currentLeft

.Top = baseShape.Top ' 基準図形の高さに揃える

currentLeft = .Left + .Width ' 次の図形の配置位置を計算

End With

Next i

' MsgBox "図形を水平に並べました。"

Else

' MsgBox "図形を選択してください。"

End If

End Sub

ぴったり縦に並べる
選択したオブジェクトを縦にぴったりと順番に並べる

実際のマクロは次の通りです。ポイントは横に並べる最初に選択したオブジェクトを軸に選択された複数のオブジェクトが順番に下に並びます。

Sub ArrangeShapesVertically()
    Dim selectedShapes As ShapeRange
    Dim baseShape As Shape
    Dim currentTop As Single
    Dim i As Integer
    
    ' 選択されている図形を取得
    If ActiveWindow.Selection.Type = ppSelectionShapes Then
        Set selectedShapes = ActiveWindow.Selection.ShapeRange
        
        ' 選択された図形が2つ以上必要
        If selectedShapes.Count < 2 Then
            MsgBox "図形を2つ以上選択してください。"
            Exit Sub
        End If
        
        ' 最初の図形を基準に設定
        Set baseShape = selectedShapes(1)
        currentTop = baseShape.Top + baseShape.Height
        
        ' 2番目以降の図形を基準図形の下側に配置
        For i = 2 To selectedShapes.Count
            With selectedShapes(i)
                .Top = currentTop
                .Left = baseShape.Left ' 基準図形の位置に揃える
                currentTop = .Top + .Height ' 次の図形の配置位置を計算
            End With
        Next i
        
        ' MsgBox "図形を垂直に並べました。"
    Else
        ' MsgBox "図形を選択してください。"
    End If
End Sub

Sub ArrangeShapesVertically()

Dim selectedShapes As ShapeRange

Dim baseShape As Shape

Dim currentTop As Single

Dim i As Integer

' 選択されている図形を取得

If ActiveWindow.Selection.Type = ppSelectionShapes Then

Set selectedShapes = ActiveWindow.Selection.ShapeRange

' 選択された図形が2つ以上必要

If selectedShapes.Count < 2 Then

MsgBox "図形を2つ以上選択してください。"

Exit Sub

End If

' 最初の図形を基準に設定

Set baseShape = selectedShapes(1)

currentTop = baseShape.Top + baseShape.Height

' 2番目以降の図形を基準図形の下側に配置

For i = 2 To selectedShapes.Count

With selectedShapes(i)

.Top = currentTop

.Left = baseShape.Left ' 基準図形の位置に揃える

currentTop = .Top + .Height ' 次の図形の配置位置を計算

End With

Next i

' MsgBox "図形を垂直に並べました。"

Else

' MsgBox "図形を選択してください。"

End If

End Sub

オブジェクトを入れ替える
選択した2つのオブジェクトの位置を入れ替えます
※下記図では黄色と青色を入れ替えてます。

実際のマクロは次の通りです。ポイントは選択した２つのオブジェクトの場所を入れ替えるマクロなので、3つ以上のオブジェクトを選択した上でマクロを実行することはできません。3つ以上のオブジェクトを一斉に入れ替えたいときは適宜グループ化してグループごと入れ替えるとよいかと思います。

Sub SwapShapes()
    Dim shp1 As Shape
    Dim shp2 As Shape
    Dim tempLeft As Single
    Dim tempTop As Single
    
    ' 選択されている図形の数を確認
    If ActiveWindow.Selection.Type = ppSelectionShapes And _
       ActiveWindow.Selection.ShapeRange.Count = 2 Then
       
        ' 選択された図形を取得
        Set shp1 = ActiveWindow.Selection.ShapeRange(1)
        Set shp2 = ActiveWindow.Selection.ShapeRange(2)
        
        ' 図形1の位置を一時変数に保存
        tempLeft = shp1.Left
        tempTop = shp1.Top
        
        ' 図形1の位置を図形2の位置に移動
        shp1.Left = shp2.Left
        shp1.Top = shp2.Top
        
        ' 図形2の位置を一時変数に保存して移動
        shp2.Left = tempLeft
        shp2.Top = tempTop
        
        ' MsgBox "選択した図形の位置を入れ替えました。"
    Else
        ' MsgBox "図形を2つだけ選択してください。"
    End If
End Sub

Sub SwapShapes()

Dim shp1 As Shape

Dim shp2 As Shape

Dim tempLeft As Single

Dim tempTop As Single

' 選択されている図形の数を確認

If ActiveWindow.Selection.Type = ppSelectionShapes And _

ActiveWindow.Selection.ShapeRange.Count = 2 Then

' 選択された図形を取得

Set shp1 = ActiveWindow.Selection.ShapeRange(1)

Set shp2 = ActiveWindow.Selection.ShapeRange(2)

' 図形1の位置を一時変数に保存

tempLeft = shp1.Left

tempTop = shp1.Top

' 図形1の位置を図形2の位置に移動

shp1.Left = shp2.Left

shp1.Top = shp2.Top

' 図形2の位置を一時変数に保存して移動

shp2.Left = tempLeft

shp2.Top = tempTop

' MsgBox "選択した図形の位置を入れ替えました。"

Else

' MsgBox "図形を2つだけ選択してください。"

End If

End Sub

作成したマクロをパワーポイントで共通的に利用できるようにする

基本的にパワーポイント上で作成したマクロはマクロ付きのパワーポイントとして保存されます。さらにそのパワーポイント上でしかマクロを動かすことができません。ここでは上記で作成したマクロをどのパワーポイントでも利用できるように設定する方法を説明します。

１．マクロ付きパワーポイントをアドイン（.ppam）として保存
前節で作成したマクロ付きのファイルをアドイン形式(.pptm)で作成しておきます。そしてアドイ形式の.pptmファイルを名前を付けて保存から「ファイルの種類：PowerPoint アドイン」を選択して保存します。ファイル名はなんでもOKです。

2.　アドインを読み込む
パワーポイントの開発リボンから「PowerPointアドイン」をクリックして、1.で保存したファイルを選択しアドインとして読み込みます。

3.　マクロをコマンドに割り当てる
作成したマクロをコマンドのボタンとして使いやすいようにカスタマイズします。今回はクイックアクセスツールバーにコマンドボタンを設定します。PowerPointのオプションからクイックアクセスツールバーを選択して「コマンドの選択：マクロ」をクリックすると先ほど作成したアドイン名とマクロの関数名が表示されていますので追加します。

4.　アドインファイルのパス名を変更する
アドインファイルとして読み込めるように参照するファイルパスを書き換えます。書き換えるファイルは以下です。メモ帳などのエディタで編集ができますが、修正前にバックアップを作成しておくことを推奨します。
C:\Users\<UserName>\AppData\Local\Microsoft\Office\PowerPoint.officeUI
修正するポイントはアドインファイルとして読み込めるように先ほど保存した「<FileName>.pptm」となっている部分について、「.pptm」⇒「.ppam」に変換します。エディタの置換機能を使うと抜けもれなく実施できます。

作業については以上です。あとは新規で作成したパワーポイントや修正中のパワーポイントなどで共通的にマクロコマンドを利用することができます。

まとめ

今回はOfficeアプリでよく使われるパワーポイントについて、標準で利用できるコマンドの紹介をさせていただきました。また標準コマンドだけでは物足りない人のために、より便利で利用しやすいマクロをボタンを開発をしました。さらにパワーポイントで共通的にマクロボタンとして利用できる設定についても紹介しました。本ページの内容を参照いただいてファイル作成にかかるコストカットに繋がれば幸いです。また追加で利用しやすいコマンドの開発ができたら順次公開していきます。