Home » パワーポイントマクロ・PowerPoint VBAの使い方 » 表・テーブル » 表の位置を移動するPowerPointマクロ

表の位置を移動するPowerPointマクロ

対象：PowerPoint2003, PowerPoint2007, PowerPoint2010, PowerPoint2013

「powerpoint vba 表の位置」
という検索で、このサイト・インストラクターのネタ帳へのアクセスがありました。

プレゼンテーションファイル上の、表の位置を指定したり移動したりする、PowerPointのVBA（Visual Basic for Applications）のコードやマクロを探している方による検索でしょうか。

参考になりそうなPowerPointのマクロをご紹介しておきましょう。

［スポンサードリンク］

アクティブなプレゼンテーションファイル上の、すべてのスライド上の、すべての表の位置を移動するマクロです。

Sub 全スライドのすべての表の位置を変更する()

　Const pos_left = 100　'スライドの左端からのポイント数
　Const pos_top = 100　'スライドの上端からのポイント数

　Dim sld As Slide
　Dim shp As Shape
　Dim msg As String

　msg = "全スライドのすべての表の位置を一括変更しますか？"
　If MsgBox(msg, vbYesNo) = vbNo Then Exit Sub

　For Each sld In ActivePresentation.Slides

　　For Each shp In sld.Shapes
　　　If shp.HasTable = msoTrue Then
　　　　shp.Left = pos_left
　　　　shp.Top = pos_top
　　　End If
　　Next shp

　Next sld

End Sub

上記のマクロを実行すると、
「全スライドのすべての表の位置を一括変更しますか？」
というメッセージボックスが表示され、［はい］ボタンをクリックすると、定数で指定されている位置に、
　Const pos_left = 100
　Const pos_top = 100
すべてのスライド上のすべての表が移動します。

全スライドに対してループを回し、
　For Each sld In ActivePresentation.Slides

全スライドに対するループの中で
各スライドの描画オブジェクトに対してループを回し、
　　For Each shp In sld.Shapes

もし描画オブジェクトが表ならば
　　　If shp.HasTable = msoTrue Then

表の位置を移動しています。
　　　　shp.Left = pos_left
　　　　shp.Top = pos_top

参考までに、アクティブなスライドの表の位置を変更するマクロをご紹介しておきます。

Sub アクティブスライドの表の位置を変更する()

　Const pos_left = 100　'スライドの左端からのポイント数
　Const pos_top = 100　'スライドの上端からのポイント数

　Dim shp As Shape

　For Each shp In ActiveWindow.Selection.SlideRange.Shapes
　　If shp.HasTable = msoTrue Then
　　　shp.Left = pos_left
　　　shp.Top = pos_top
　　End If
　Next

End Sub

アクティブなスライド上の、すべての描画オブジェクトに対してループを回して、
　For Each shp In ActiveWindow.Selection.SlideRange.Shapes

もし表だったならば
　　　If shp.HasTable = msoTrue Then

表の位置を移動しています。
　shp.Left = pos_left
　shp.Top = pos_top

もう一つ、アクティブなスライド以降のスライドの位置を変更するマクロもご紹介しておきましょう。

Sub アクティブスライド以降のスライドの表の位置を一括変更する()
　
　Const pos_left = 100　'スライドの左端からのポイント数
　Const pos_top = 100　'スライドの上端からのポイント数

　Dim act_sld As Long
　Dim shp As Shape
　Dim i As Long
　Dim msg As String

　With ActiveWindow.Selection
　　If .Type = ppSelectionNone Then
　　　msg = "スライドを選択してから実行してください。"
　　　MsgBox msg
　　　Exit Sub
　　Else
　　　act_sld = .SlideRange.SlideIndex
　　End If
　End With

　msg = "アクティブなスライド以降の表の位置を一括変更しますか？"
　If MsgBox(msg, vbYesNo) = vbNo Then Exit Sub

　With ActivePresentation
　　For i = act_sld To .Slides.Count

　　　For Each shp In .Slides(i).Shapes
　　　　If shp.HasTable = msoTrue Then
　　　　　shp.Left = pos_left
　　　　　shp.Top = pos_top
　　　　End If
　　　Next shp

　　Next i
　End With

End Sub

メインの処理に入る前に、何が選択されているのかをチェックする処理や、アクティブなスライドのスライド番号を取得する処理が入っているため、最初にご紹介した全スライドに対するマクロよりも長くなっています。

もし、何も選択されていなければ、
　With ActiveWindow.Selection
　　If .Type = ppSelectionNone Then

メッセージを表示してSubプロシージャを終了しています。
　　　msg = "スライドを選択してから実行してください。"
　　　MsgBox msg
　　　Exit Sub

そうでなければ、アクティブなスライド番号を変数に格納します。
　　Else
　　　act_sld = .SlideRange.SlideIndex

アクティブスライド以降のスライドに対し、カウンタ変数・iを使ったFor ～ Next文でループを回し、
　With ActivePresentation
　　For i = act_sld To .Slides.Count

そのループの中で、各スライドですべての描画オブジェクトに対してループを回して
　　　For Each shp In .Slides(i).Shapes

表だったならば、位置を移動するのは、最初にご紹介した全スライドのすべての表の位置を移動するマクロと同じです。
　　　　If shp.HasTable = msoTrue Then
　　　　　shp.Left = pos_left
　　　　　shp.Top = pos_top