パワポ マクロ 図形の配置 整列を探る 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

参考URL:

ShapeRange.Align メソッド (PowerPoint)
https://docs.microsoft.com/ja-jp/office/vba/api/powerpoint.shaperange.align

ShapeRange.Distribute メソッド (PowerPoint)
https://docs.microsoft.com/ja-jp/office/vba/api/powerpoint.shaperange.distribute

などを参考にするとよいのでは？

処理のヒント・参考となれば幸いです。