■ 最新の投稿

仕事納め前の小ネタ。Excelマクロでクリスマスツリーを描く!

たまには、Excelで遊んでみる

年末になると、
どの資料もどのシートも、数字と文字ばかり。

たまには、
Excelで「意味のないこと」をやってみるのも悪くありません。

ということで今回は、

マクロを実行すると、図形だけでクリスマスツリーを描く🎄

そんな、ちょっとした遊びネタです。

できあがるもの

  • ▲(三角)= 葉っぱ
  • ●(丸)= オーナメント
  • ■(四角)= 幹
  • ★(星)= てっぺん

セルは使わず、すべて図形で描きます。

Sub DrawChristmasTree()

    Dim ws As Worksheet
    Set ws = ActiveSheet

    Dim i As Long, j As Long
    Dim centerX As Double
    Dim startTop As Double

    ' 既存の図形を削除
    ws.Shapes.SelectAll
    On Error Resume Next
    Selection.Delete
    On Error GoTo 0

    centerX = 300
    startTop = 50

    ' -----------------------
    ' 葉っぱ(▲ 三角)
    ' -----------------------
    For i = 1 To 5
        Dim tri As Shape
        Set tri = ws.Shapes.AddShape(msoShapeIsoscelesTriangle, _
                                     centerX - (i * 60), _
                                     startTop + (i * 50), _
                                     i * 120, _
                                     80)
        tri.Fill.ForeColor.RGB = RGB(0, 140, 0)
        tri.Line.Visible = msoFalse
    Next i

    ' -----------------------
    ' オーナメント(● 丸)
    ' -----------------------
    Randomize
    For i = 1 To 12
        Dim ball As Shape
        Set ball = ws.Shapes.AddShape(msoShapeOval, _
                                      centerX - 120 + Rnd * 240, _
                                      startTop + 80 + Rnd * 220, _
                                      18, 18)
        ball.Fill.ForeColor.RGB = RGB(200 + Rnd * 55, Rnd * 200, Rnd * 200)
        ball.Line.Visible = msoFalse
    Next i

    ' -----------------------
    ' 幹(■ 四角)
    ' -----------------------
    Dim trunk As Shape
    Set trunk = ws.Shapes.AddShape(msoShapeRectangle, _
                                   centerX - 25, _
                                   startTop + 330, _
                                   50, _
                                   60)
    trunk.Fill.ForeColor.RGB = RGB(120, 80, 40)
    trunk.Line.Visible = msoFalse

    ' -----------------------
    ' 星(★)
    ' -----------------------
    Dim star As Shape
    Set star = ws.Shapes.AddShape(msoShape5pointStar, _
                                  centerX - 20, _
                                  startTop - 10, _
                                  40, _
                                  40)
    star.Fill.ForeColor.RGB = RGB(255, 215, 0)
    star.Line.Visible = msoFalse

End Sub

マクロを実行すると・・・

ツリーが出現🎄(笑)

メリークリスマス!


Comments

コメントを残す

メールアドレスが公開されることはありません。 が付いている欄は必須項目です