PowerPoint VBA スライドサイズの四角形を作るマクロ

PowerPoint VBAを使い、選択中のスライドにスライドサイズの四角形を作るマクロをご紹介します。

スライドマスターとレイアウトには、それぞれ1スライド目に四角形が作成されます。

スライドサイズの四角形を作るマクロ

スライドに作成

Sub スライドサイズの四角形を作成()

    Dim n As Long
    Dim w As Single
    Dim h As Single
    Dim shp As shape
    
    '選択中のスライド番号を取得
    n = ActiveWindow.Selection.SlideRange.SlideIndex
    
    'スライドサイズ取得
    w = ActivePresentation.PageSetup.SlideWidth
    h = ActivePresentation.PageSetup.SlideHeight

    With ActivePresentation

            'スライドサイズの四角形を作成
            Set shp = .Slides(n).Shapes.AddShape( _
            Type:=msoShapeRectangle, _
            Left:=0, _
            Top:=0, _
            Width:=w, _
            Height:=h)
      
            '四角形の色
            shp.Fill.ForeColor.RGB = RGB(0, 0, 0)
            '線なし
            shp.Line.Visible = msoFalse

    End With
End Sub

スライドマスターに作成

Sub スライドマスターにスライドサイズの四角形を作成()

    Dim n As Long
    Dim w As Single
    Dim h As Single
    Dim shp As Shape
    
    'スライドサイズ取得
    w = ActivePresentation.PageSetup.SlideWidth
    h = ActivePresentation.PageSetup.SlideHeight

    With ActivePresentation.Designs(1).SlideMaster

            'スライドサイズの四角形を作成
            Set shp = .Shapes.AddShape( _
            Type:=msoShapeRectangle, _
            Left:=0, _
            Top:=0, _
            Width:=w, _
            Height:=h)
      
            '四角形の色
            shp.Fill.ForeColor.RGB = RGB(0, 0, 0)
            '線なし
            shp.Line.Visible = msoFalse

    End With
End Sub

レイアウトに作成

Sub レイアウトにスライドサイズの四角形を作成()

    Dim n As Long
    Dim w As Single
    Dim h As Single
    Dim shp As Shape
    
    'スライドサイズ取得
    w = ActivePresentation.PageSetup.SlideWidth
    h = ActivePresentation.PageSetup.SlideHeight

    With ActivePresentation.Designs(1).SlideMaster.CustomLayouts(1)

            'スライドサイズの四角形を作成
            Set shp = .Shapes.AddShape( _
            Type:=msoShapeRectangle, _
            Left:=0, _
            Top:=0, _
            Width:=w, _
            Height:=h)
      
            '四角形の色
            shp.Fill.ForeColor.RGB = RGB(0, 0, 0)
            '線なし
            shp.Line.Visible = msoFalse

    End With
End Sub

作成する四角形の塗りはデフォルトで黒にしています。RGBの値でお好みに変更できます。