パワポのおすすめフリー素材サイトはこちら▶︎

【パワポVBA】大阪万博2025ロゴを召喚するマクロ

スポンサーリンク
2020.09.01

PowerPoint VBAの魔法で、大阪・関西万博2025ロゴを召喚するマクロをご紹介します。

キャラメルコーンのパッケージとポンデリングがフュージョンしたようなデザインが魅力的です。

スポンサーリンク
スポンサーリンク

大阪万博2025ロゴを召喚するマクロ

コード

Sub 大阪万博2025ロゴを召喚()

    Dim n As Long
    Dim shp As Shape
    Dim List() As Variant
    Dim w As Single
    Dim h As Single
    
    '選択中のスライド番号を取得
    n = ActiveWindow.Selection.SlideRange.SlideIndex

    With ActivePresentation.Slides(n).Shapes

        '赤い円を描く
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(2.86 * 720 / 25.4, 1), _
        Top:=0, _
        Width:=Round(2.25 * 720 / 25.4, 1), _
        Height:=Round(2.25 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(230, 0, 18)
        shp.Line.Visible = msoFalse
        shp.Name = "shp1"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(4.88 * 720 / 25.4, 1), _
        Top:=Round(0.06 * 720 / 25.4, 1), _
        Width:=Round(2.9 * 720 / 25.4, 1), _
        Height:=Round(2.9 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(230, 0, 18)
        shp.Line.Visible = msoFalse
        shp.Name = "shp2"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(5.61 * 720 / 25.4, 1), _
        Top:=Round(2.45 * 720 / 25.4, 1), _
        Width:=Round(3.45 * 720 / 25.4, 1), _
        Height:=Round(1.6 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(230, 0, 18)
        shp.Line.Visible = msoFalse
        shp.Name = "shp3"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(6.19 * 720 / 25.4, 1), _
        Top:=Round(3.57 * 720 / 25.4, 1), _
        Width:=Round(2.05 * 720 / 25.4, 1), _
        Height:=Round(2.5 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(230, 0, 18)
        shp.Line.Visible = msoFalse
        shp.Name = "shp4"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(5.43 * 720 / 25.4, 1), _
        Top:=Round(5.72 * 720 / 25.4, 1), _
        Width:=Round(3.15 * 720 / 25.4, 1), _
        Height:=Round(2.8 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(230, 0, 18)
        shp.Line.Visible = msoFalse
        shp.Name = "shp5"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(3.67 * 720 / 25.4, 1), _
        Top:=Round(7.3 * 720 / 25.4, 1), _
        Width:=Round(2.7 * 720 / 25.4, 1), _
        Height:=Round(2.7 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(230, 0, 18)
        shp.Line.Visible = msoFalse
        shp.Name = "shp6"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(2.13 * 720 / 25.4, 1), _
        Top:=Round(7.46 * 720 / 25.4, 1), _
        Width:=Round(1.95 * 720 / 25.4, 1), _
        Height:=Round(1.95 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(230, 0, 18)
        shp.Line.Visible = msoFalse
        shp.Name = "shp7"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(1.52 * 720 / 25.4, 1), _
        Top:=Round(5.85 * 720 / 25.4, 1), _
        Width:=Round(1.4 * 720 / 25.4, 1), _
        Height:=Round(2.3 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(230, 0, 18)
        shp.Line.Visible = msoFalse
        shp.Name = "shp8"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(0.13 * 720 / 25.4, 1), _
        Top:=Round(4.12 * 720 / 25.4, 1), _
        Width:=Round(2.55 * 720 / 25.4, 1), _
        Height:=Round(2.55 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(230, 0, 18)
        shp.Line.Visible = msoFalse
        shp.Name = "shp9"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=0, _
        Top:=Round(2.19 * 720 / 25.4, 1), _
        Width:=Round(2.15 * 720 / 25.4, 1), _
        Height:=Round(2.15 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(230, 0, 18)
        shp.Line.Visible = msoFalse
        shp.Name = "shp10"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(1.58 * 720 / 25.4, 1), _
        Top:=Round(2.83 * 720 / 25.4, 1), _
        Width:=Round(1.9 * 720 / 25.4, 1), _
        Height:=Round(1.9 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(230, 0, 18)
        shp.Line.Visible = msoFalse
        shp.Name = "shp11"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(1.66 * 720 / 25.4, 1), _
        Top:=Round(1.16 * 720 / 25.4, 1), _
        Width:=Round(1.9 * 720 / 25.4, 1), _
        Height:=Round(2.1 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(230, 0, 18)
        shp.Line.Visible = msoFalse
        shp.Name = "shp12"
        
        '白い円を描く
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(6.02 * 720 / 25.4, 1), _
        Top:=Round(0.35 * 720 / 25.4, 1), _
        Width:=Round(1.25 * 720 / 25.4, 1), _
        Height:=Round(1.25 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
        shp.Line.Visible = msoFalse
        shp.Name = "shp13"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(6.81 * 720 / 25.4, 1), _
        Top:=Round(6.54 * 720 / 25.4, 1), _
        Width:=Round(1.55 * 720 / 25.4, 1), _
        Height:=Round(1.4 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
        shp.Line.Visible = msoFalse
        shp.Name = "shp14"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(4.42 * 720 / 25.4, 1), _
        Top:=Round(8.65 * 720 / 25.4, 1), _
        Width:=Round(0.95 * 720 / 25.4, 1), _
        Height:=Round(0.95 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
        shp.Line.Visible = msoFalse
        shp.Name = "shp15"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(1.14 * 720 / 25.4, 1), _
        Top:=Round(5.01 * 720 / 25.4, 1), _
        Width:=Round(1.2 * 720 / 25.4, 1), _
        Height:=Round(1.15 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
        shp.Line.Visible = msoFalse
        shp.Name = "shp16"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(0.25 * 720 / 25.4, 1), _
        Top:=Round(2.62 * 720 / 25.4, 1), _
        Width:=Round(1.1 * 720 / 25.4, 1), _
        Height:=Round(1.1 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
        shp.Line.Visible = msoFalse
        shp.Name = "shp17"
        
        '青い円を描く
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(6.55 * 720 / 25.4, 1), _
        Top:=Round(0.43 * 720 / 25.4, 1), _
        Width:=Round(0.6 * 720 / 25.4, 1), _
        Height:=Round(0.6 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(0, 105, 183)
        shp.Line.Visible = msoFalse
        shp.Name = "shp18"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(7.66 * 720 / 25.4, 1), _
        Top:=Round(6.74 * 720 / 25.4, 1), _
        Width:=Round(0.65 * 720 / 25.4, 1), _
        Height:=Round(0.65 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(0, 105, 183)
        shp.Line.Visible = msoFalse
        shp.Name = "shp19"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(4.7 * 720 / 25.4, 1), _
        Top:=Round(9.2 * 720 / 25.4, 1), _
        Width:=Round(0.4 * 720 / 25.4, 1), _
        Height:=Round(0.4 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(0, 105, 183)
        shp.Line.Visible = msoFalse
        shp.Name = "shp20"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(1.44 * 720 / 25.4, 1), _
        Top:=Round(5.01 * 720 / 25.4, 1), _
        Width:=Round(0.54 * 720 / 25.4, 1), _
        Height:=Round(0.54 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(0, 105, 183)
        shp.Line.Visible = msoFalse
        shp.Name = "shp21"
        
        Set shp = .AddShape( _
        Type:=msoShapeOval, _
        Left:=Round(0.29 * 720 / 25.4, 1), _
        Top:=Round(2.75 * 720 / 25.4, 1), _
        Width:=Round(0.53 * 720 / 25.4, 1), _
        Height:=Round(0.53 * 720 / 25.4, 1))
        shp.Fill.ForeColor.RGB = RGB(0, 105, 183)
        shp.Line.Visible = msoFalse
        shp.Name = "shp22"
        
        'すべての図形を配列に追加
        For a = 0 To 21
            ReDim Preserve List(a)
            List(a) = "shp" & a + 1
        Next a
        
        'すべての図形をグループ化
        .Range(List).Group
        
        '縦横比を固定
        .Range.LockAspectRatio = msoTrue
        
        'スライドサイズ取得
        w = ActivePresentation.PageSetup.SlideWidth
        h = ActivePresentation.PageSetup.SlideHeight
        
        'スライドの中央に召喚
        .Range.Left = (w - .Range.Width) / 2
        .Range.Top = (h - .Range.Height) / 2
            
    End With
End Sub
スポンサーリンク

実行結果

実行するとスライドの中央に大阪万博2025ロゴが召喚されます。