[VBA]さざえ堂の螺旋構造をＥＸＣＥＬで作る

お疲れ様です。かなタイプが１秒１打まで成長したえんちゃです。まだまだです。

自分かなり、旅行が好きなんですが、
皆さん、さざえ堂って知っていますか？
福島県会津若松市にあるお堂で、重要文化財なんですね
来年にも行ってみたいものです。

ところでこのお堂、かなり得意な構造になっていまして、
参拝者が上り下りするための螺旋スロープがありますが、
不思議なことに、そこでは登る人と降りる人が遭遇することは決してありません。

ということなんです。

どういうことかというと、二重スロープになっていて、実は一本道になっているんですね。

どういうこっちゃ
わけわからないのでエクセルで作ってみました。

Sub Macro1()
    Dim obj As Shape
　　'72段作る'
    For i = 0 To 720 Step 10
　　　　 '階段の板を作成'
        Set obj = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 1000, 1000, 284, 40)
        With ActiveSheet.Shapes.Range(obj.Name).Fill
            .Visible = msoTrue
　　　　　　　'色を作る'
            .ForeColor.RGB = RGB(i / 720 * 255, Abs(i / 720 * 255 - 255 / 2), 255 - i / 720 * 255)
            .Transparency = 0
            .Solid
        End With
        With ActiveSheet.Shapes.Range(obj.Name)
            .Line.Visible = msoFalse
            .IncrementRotation i
            .ThreeD.BevelTopInset = 9
            .ThreeD.BevelTopDepth = 14.5
            .ThreeD.Z = i * 1.5
        End With
    Next i
 　 '円柱を作成'
    Set obj = ActiveSheet.Shapes.AddShape(msoShapeOval, 1090, 980, 100, 100)
    ActiveSheet.Shapes.Range(obj.Name).ThreeD.BevelBottomDepth = 1082
    ActiveSheet.Shapes.Range(obj.Name).Line.Visible = msoFalse
    With ActiveSheet.Shapes.Range(obj.Name).Fill
        .Visible = msoTrue
        .ForeColor.RGB = RGB(50, 50, 50)
        .Transparency = 0
        .Solid
    End With
    ActiveSheet.Shapes.Range(obj.Name).ThreeD.Z = 1068
    '結合してから回転する'
    ActiveSheet.Shapes.SelectAll
    Set obj = Selection.ShapeRange.Group
    ActiveSheet.Shapes.Range(obj.Name).ThreeD.IncrementRotationX -5
    ActiveSheet.Shapes.Range(obj.Name).ThreeD.IncrementRotationY -30
End Sub

うーんめっちゃきれいですね。
大事なのは結合(グループ化)してから回転させる。ということです。
結合しないと、個々で３D回転しててんでんばらばらになります。気をつけてください。

趣味の記事でした。