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ロゴが召喚されます。