直感的な「角度の理解」に向けて ⑥ ～ 初期値を45°の倍数に ～

前回まで、直感的な角度の理解を目的として、クイズ形式のマクロを作成してきた。
infoment.hatenablog.com
今日は、細かな修正を以って仕上げとする。

まず、明らかな間違いが一点あり、これを修正。
指定角度より小さな角度で判定した場合、例えば10°小さい場合、メッセージは
「残念！-10° 小さいです」
となっていた。残念！-10°小さいってことは、10°大きいってこと。頭にマイナスを付して、対応した。

MsgBox "残念！　" & -Result & "°小さいです。"

初期値が常に90°であったため、例えば乱数で指定した角度が360°となった場合、270°も扇形を広げる必要があった。

そこで、半ばヒントになってしまうが、45°単位で一番近い位置を初期値とした。

ScrollBar1.Value = WorksheetFunction.MRound(Answer, 45)

答えが丸見えだったため、隠したり見せたりするスピンボタンを設置。

まあ、こんなものかな。ということで、満を持して長女に訊いてみた。
「これで、ちょっと遊んでみない？」
「え～、やだ」
「；￣ロ￣）！！」

でも、その後に、喜んで遊んでくれました。良かった良かった。

◆今回のソースコード（クリックで展開）◆

Option Explicit
Dim Shape As Excel.Shape
Dim Wrong As Excel.Shape
Dim Answer As Long

Private Sub SpinButton1_SpinUp()
    UserForm1.Height = 115
End Sub

Private Sub SpinButton1_SpinDown()
    UserForm1.Height = 140
End Sub

Private Sub StartButton_Click()
    UserForm1.Height = 115
    Answer = Rnd * 360
    Label5.Caption = "指定角度：" & Answer & "°"
    ScrollBar1.Value = WorksheetFunction.MRound(Answer, 45)
End Sub

Private Sub JudgeButton_Click()
    Dim Result As Long
        Result = ScrollBar1.Value - Answer
        If Result < 0 Then
            Set Wrong = DrawShape(msoThemeColorAccent2)
                Wrong.Adjustments.Item(1) = Answer * -1
                Wrong.ZOrder msoSendToBack
            MsgBox "残念！　" & -Result & "°小さいです。"
        ElseIf Result > 0 Then
            Set Wrong = DrawShape(msoThemeColorAccent2)
                Wrong.Adjustments.Item(1) = Answer * -1
            MsgBox "残念！　" & Result & "°大きいです。"
        Else
            MsgBox "正解！！"
        End If
        
        UserForm1.Height = 140
End Sub

Private Sub ScrollBar1_Change()
    On Error Resume Next
    If Not Wrong Is Nothing Then Wrong.Delete
    Label1.Caption = "角度：" & ScrollBar1.Value & "°"
    Shape.Adjustments.Item(1) = ScrollBar1.Value * -1
End Sub

Private Sub UserForm_Initialize()
    ResetShape
    
    SpinButton1.Max = 1
    SpinButton1.Min = 0
End Sub

Private Sub UserForm_Terminate()
    Shape.Delete
    On Error Resume Next
    If Not Wrong Is Nothing Then Wrong.Delete
End Sub

Private Function DrawShape(object_theme_color As MsoThemeColorIndex) As Shape
    Dim TempShape As Excel.Shape
    Set TempShape = ActiveSheet.Shapes.AddShape(msoShapeArc, 150, 100, 100, 100)
    With TempShape.Fill
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = object_theme_color
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Solid
    End With
    
    Set DrawShape = TempShape
End Function

Private Sub ResetShape()
    Set Shape = DrawShape(msoThemeColorAccent1)
    
    ScrollBar1.Min = 0
    ScrollBar1.Max = 360
    ScrollBar1.Value = 90
End Sub

参考まで。