PowerPoint VBA パックマンを部分円で作るマクロ

図形の結合

2020.07.192021.05.22

PowerPoint VBAを使い、パックマン（PAC-MAN）を作成するマクロをご紹介します。

部分円をパックマンに見立て、円の開きの角度を変えてパックマンの口を表現します。部分円は定数「msoShapePie」を使用して描くことができます。

この記事の目次

パックマンを作成するマクロ
1. コード
2. 実行結果
部分円の開ける角度を指定するマクロ
1. コード
2. 実行結果
部分円の余分な余白を削除する

パックマンを作成するマクロ

コード

Sub パックマンを作成()

    Dim n As Long
    Dim w As Single
    Dim h As Single
    Dim diameter As Single
    Dim shp As shape
    
    '選択中のスライド番号を取得
    n = ActiveWindow.Selection.SlideRange.SlideIndex
    
    'スライドサイズ取得
    w = ActivePresentation.PageSetup.SlideWidth
    h = ActivePresentation.PageSetup.SlideHeight
    
    'パックマンの直径を「cm」で入力
    diameter = 5
    
    '直径を「pt」に変換
    diameter = Round(diameter * 720 / 25.4, 1)

    With ActivePresentation.Slides(n)

        'パックマンをスライド中央に挿入
        Set shp = .Shapes.AddShape( _
        Type:=msoShapePie, _
        Left:=(w - diameter) / 2, _
        Top:=(h - diameter) / 2, _
        Width:=diameter, _
        Height:=diameter)
        
        '口の開き
        shp.Adjustments(1) = 27
        shp.Adjustments(2) = 333
        
        '図形の色
        shp.Fill.ForeColor.RGB = RGB(255, 255, 0)
        
        '図形の線なし
        shp.Line.Visible = msoFalse
        
        '背景の色
        .FollowMasterBackground = msoFalse
        .Background.Fill.ForeColor.RGB = RGB(0, 0, 0)

    End With
End Sub

実行結果

実行するとパックマンがスライドの中央に挿入されます。パックマンが映えるように背景が黒色で塗りつぶされるようにしています。

図形の種類は、定数「msoShapePie」で部分円を指定しています。

口の開きは「shp.Adjustments(1) 」と「shp.Adjustments(2) 」の値で調整ができます。

部分円の開ける角度を指定するマクロ

部分円の2つの調整ハンドルを「Adjustments」プロパティで角度指定することで、円の開きを自由に設定することができます。

コード

Sub 部分円の開きを指定する()

    Dim angle As String
    Dim n As Long
    Dim w As Single
    Dim h As Single
    Dim diameter As Single
    Dim shp As shape
    
    '角度入力フォーム
    angle = InputBox("開ける角度を入力してください。")
    
    '数値以外が入力された場合はマクロ終了
    If IsNumeric(angle) Then
    ElseIf angle = "" Then
        Exit Sub
    Else
        msg = "数値を入力してください。"
        MsgBox msg
        Exit Sub
    End If
    
    '選択中のスライド番号を取得
    n = ActiveWindow.Selection.SlideRange.SlideIndex
    
    'スライドサイズ取得
    w = ActivePresentation.PageSetup.SlideWidth
    h = ActivePresentation.PageSetup.SlideHeight
    
    '部分円の直径「cm」を入力
    diameter = 5
    
    '直径を「cm」に変換
    diameter = Round(diameter * 720 / 25.4, 1)

    With ActivePresentation.Slides(n)

        '部分円をスライド中央に挿入
        Set shp = .Shapes.AddShape( _
        Type:=msoShapePie, _
        Left:=(w - diameter) / 2, _
        Top:=(h - diameter) / 2, _
        Width:=diameter, _
        Height:=diameter)
        
        '円の開き
        shp.Adjustments(1) = angle - 90
        shp.Adjustments(2) = -90
        
        '図形の色
        shp.Fill.ForeColor.RGB = RGB(0, 0, 0)
        
        '図形の線なし
        shp.Line.Visible = msoFalse

    End With
End Sub