パワポマクロ図形の配置整列を探る PowerPoint VBA ShapeRangeに対してAlign Distribute メソッドを使用

知恵袋の質問に、PowerPointで図形を左揃え、上揃え、均等の質問があったので、
パワポ VBA ユーザフォームで図形の配置整列を探ってみました。

知恵袋の質問
detail.chiebukuro.yahoo.co.jp
↑に回答してみました。

下記、いつものあのあのそのそのイライラ解説動画・・・
youtu.be
https://youtu.be/46MBczsYmww
目次
00:00 挨拶、処理内容
00:59 0.テスト実行
02:00 1.コードの説明
04:48 2.便利なユーザフォームのモードレスモード
07:32 3.簡単なエラーチェック
09:51 均等の時は選択数をチェック
12:50 4.蛇足で他のプレゼンでテスト

0.テスト実行
はじめにテスト結果を見せる。

作成したと言っても、選択されたオブジェクトにメソッドを一行実行しただけです。

1.選択されているオブジェクト
ActiveWindow.Selection
で、選択されたオブジェクトが取得できるので、

選択されたシェイプ図形・テキストボックス
ActiveWindow.Selection.ShapeRange
に対して、

1.1 .Align メソッドで位置指定

ShapeRange.Align メソッド (PowerPoint)
https://docs.microsoft.com/ja-jp/office/vba/api/powerpoint.shaperange.align
を参考に
'単純に選択シェイプに対して.Alignメソッドで左寄せ
ActiveWindow.Selection.ShapeRange.Align msoAlignLefts, msoFalse

https://docs.microsoft.com/ja-jp/office/vba/api/office.msoaligncmd

名前値説明
msoAlignBottoms 5 指定されたオブジェクトを下揃えにします。
msoAlignCenters 1 指定されたオブジェクトを左右中央揃えにします。
msoAlignLefts 0 指定されたオブジェクトを左揃えにします。
msoAlignMiddles 4 指定されたオブジェクトを上下中央揃えにします。
msoAlignRights 2 指定されたオブジェクトを右揃えにします。
msoAlignTops 3 指定されたオブジェクトを上揃えにします。

1.2 .Distribute メソッドで均等整列
ShapeRange.Distribute メソッド (PowerPoint)
https://docs.microsoft.com/ja-jp/office/vba/api/powerpoint.shaperange.distribute
を参考に
'単純に選択シェイプに対して.Distributeメソッドで左右均等
ActiveWindow.Selection.ShapeRange.Distribute msoDistributeHorizontally, msoFalse

https://docs.microsoft.com/ja-jp/office/vba/api/office.msodistributecmd

名前値説明
msoDistributeHorizontally 0 左右に整列させます。
msoDistributeVertically 1 上下に整列させます。

2.便利なユーザフォームのモードレスモード
上記コードで、コマンドっぽく、VBAで処理ができたので、
あとは、
ユーザーフォームを開くときに、

Sub テストフォームを開く()

    UserForm1.Show vbModeless  'vbModelessで開き、操作テスト

End Sub

と
.Show vbModeless モードレスモードで開くと、
UserFormを開いたまま、パワポを操作できるので、連続作業の時、便利かなぁ。

3.簡単なエラーチェックしかしていませんが

3.1 Selection.Type 選択されたオブジェクトは何？
ActiveWindow.Selection.Type で選択されているオブジェクトのタイプがわかります
シェイプ図形やテキストボックスを未選択で処理を走らせるとエラーが起こるので、
チェックしてみました。

    If ActiveWindow.Selection.Type <> ppSelectionShapes Then
        MsgBox "Shape図形やテキストボックスを選択してね"
        Exit Sub
    End If

3.2 .ShapeRange.Count 選択されたシェイプの数
均等割り付けには、３つ以上のオブジェクトが必要なので、
.ShapeRange.Countでチェックしてみました。

    '均等には３つ以上オブジェクトが必要なので.Count ＜ 3でチェック
    If ActiveWindow.Selection.ShapeRange.Count < 3 Then
        MsgBox "３つ以上Shape図形やテキストボックスを選択してね", vbInformation
        Exit Sub
    End If

作成したソースコード

'標準モジュール
Sub テストフォームを開く()
    UserForm1.Show vbModeless  'vbModelessで開き、操作テスト
End Sub

'UserForm1に４つボタンを作りテストしました
Option Explicit

Private Sub CommandButton1_Click()
    If ActiveWindow.Selection.Type <> ppSelectionShapes Then
        MsgBox "Shape図形やテキストボックスを選択してね"
        Exit Sub
    End If
    
    '単純に選択シェイプに対して.Alignメソッドで左寄せ
    ActiveWindow.Selection.ShapeRange.Align msoAlignLefts, msoFalse

End Sub

Private Sub CommandButton2_Click()
    If ActiveWindow.Selection.Type <> ppSelectionShapes Then
        MsgBox "Shape図形やテキストボックスを選択してね"
        Exit Sub
    End If
    
    '単純に選択シェイプに対して.Alignメソッドで上そろえ
    ActiveWindow.Selection.ShapeRange.Align msoAlignTops, msoFalse
    
End Sub

Private Sub CommandButton3_Click()
    If ActiveWindow.Selection.Type <> ppSelectionShapes Then
        MsgBox "Shape図形やテキストボックスを選択してね"
        Exit Sub
    End If
    
    '均等には３つ以上オブジェクトが必要なので.Count < 3でチェック
    If ActiveWindow.Selection.ShapeRange.Count < 3 Then
        MsgBox "３つ以上Shape図形やテキストボックスを選択してね", vbInformation
        Exit Sub
    End If
    
    '単純に選択シェイプに対して.Distributeメソッドで 左右均等
    ActiveWindow.Selection.ShapeRange.Distribute msoDistributeHorizontally, msoFalse
 
End Sub

Private Sub CommandButton4_Click()
    If ActiveWindow.Selection.Type <> ppSelectionShapes Then
        MsgBox "Shape図形やテキストボックスを選択してね"
        Exit Sub
    End If

    '均等には３つ以上オブジェクトが必要なので.Count < 3でチェック
    If ActiveWindow.Selection.ShapeRange.Count < 3 Then
        MsgBox "３つ以上Shape図形やテキストボックスを選択してね", vbInformation
        Exit Sub
    End If

    '単純に選択シェイプに対して.Distributeメソッドで 上下均等
    ActiveWindow.Selection.ShapeRange.Distribute msoDistributeVertically, msoFalse

End Sub