パワポの【疑問】を解決!「よくあるご質問」はこちら ▶︎
スポンサーリンク
スポンサーリンク

PowerPoint VBA 図形を等間隔に連続複製するマクロ

PowerPoint VBAを使い、図形を指定の間隔を空けて連続複製するマクロをご紹介します。

通常、パワポではだいたいの間隔で図形を等間隔に並べます。(毎度グリッドの設定をするのも手間なので…)

でも、今日でだいたいの間隔とは卒業!

Illustratorのように間隔を指定して複製したい!

そんな願いが叶う「間隔を指定をして連続複製できるマクロ」を作りました。

複製時の空きが指定できると、グリッドの設定をしなくても水平方向と垂直方向の間隔を揃えて連続複製することができます。

スポンサーリンク

右に等間隔に複製するマクロ

コード

Sub 右に等間隔に複製()

    Dim msg As String
    Dim n As Long
    Dim spacing As Single
    
    'オブジェクトの間隔を「cm」で指定
    spacing = 0.5
    
    '間隔を「pt」に変換
    spacing = Round(spacing * 720 / 25.4, 1)

    '選択中のオブジェクトをコピー
    With ActiveWindow.Selection
    
        'オブジェクトが選択されていない場合はマクロ終了
        If .Type = ppSelectionNone _
        Or .Type = ppSelectionSlides Then
        
            msg = "オブジェクトを選択してください。"
            MsgBox msg
            Exit Sub
            
        End If
    
        With .ShapeRange
        
            'オブジェクトをコピー
            .Copy
            'コピー元の位置を代入
            x = .Top
            y = .Left
            'コピー元の幅を代入
            w = .Width
            
        End With
    End With
        
    '選択中のスライド番号を取得
    n = ActiveWindow.Selection.SlideRange.SlideIndex
    
    '右に空き0cmで複製
    With ActivePresentation.Slides(n).Shapes.Paste
    
        '複製先の位置
        .Top = x
        .Left = y + w + spacing
        '複製したオブジェクトを選択
        .Select
        
    End With
End Sub

「spacing」の値で複製時のオブジェクトの間隔を指定します。間隔を「0.5cm」空けて複製したい場合は「spacing = 0.5」にします。

下に等間隔に複製するマクロ

コード

Sub 下に等間隔に複製()

    Dim msg As String
    Dim n As Long
    Dim spacing As Single
    
    'オブジェクトの間隔を「cm」で指定
    spacing = 0.5
    
    '間隔を「cm」に変換
    spacing = Round(spacing * 720 / 25.4, 1)

    '選択中のオブジェクトをコピー
    With ActiveWindow.Selection
    
        'オブジェクトが選択されていない場合はマクロ終了
        If .Type = ppSelectionNone _
        Or .Type = ppSelectionSlides Then
        
            msg = "オブジェクトを選択してください。"
            MsgBox msg
            Exit Sub
            
        End If
    
        With .ShapeRange
        
            'オブジェクトをコピー
            .Copy
            'コピー元の位置を代入
            x = .Top
            y = .Left
            'コピー元の高さを代入
            h = .Height
            
        End With
    End With
        
    '選択中のスライド番号を取得
    n = ActiveWindow.Selection.SlideRange.SlideIndex
    
    '下に空き0cmで複製
    With ActivePresentation.Slides(n).Shapes.Paste
    
        '複製先の位置
        .Top = x + h + spacing
        .Left = y
        '複製したオブジェクトを選択
        .Select
        
    End With
End Sub

実行結果

複製したい図形を選択し、オブジェクトの間隔を「0.5cm」に指定して「右に等間隔に複製」マクロを実行します。

実行する度に右方向へ「0.5cm」間隔を空けて複製されます。

複数の図形に実行する場合は、全ての図形をグループ化してから選択して実行します。

グループ化した図形に、オブジェクトの間隔を「0.5cm」に指定して「下に等間隔に複製」マクロを実行します。

実行する度に下方向へ「0.5cm」間隔を空けて複製されます。

きちんと空ける間隔を指定して並べると気持ちが良いです。

さよならグリッド

スポンサーリンク

マクロを連続で実行するには?

上記のマクロは、連続で実行した時に最大の効果を発揮します。マクロを連続で実行する1番簡単な方法は「Visual Basic Editor」の実行ボタンを連打する方法です。

使用頻度が少ないマクロであれば上記の方法でも問題ありませんが、使用頻度が高いマクロはリボンに実行ボタンを追加しておくとアクセスしやすくなり便利です。

追加方法は、次のチュートリアルをご参考にしていただければ幸いです。

PowerPointでマクロをアドイン化しリボンに追加する方法
PowerPointで複数のマクロをまとめてアドイン化し、リボンにマクロの実行ボタンを追加する方法を…