Excelであみだくじ を作ってみよう

シートのVBAコード

下記のVBAコードを追加してください。

'あみだ範囲のクリア
Private Sub ExAmidaClear()
    Dim i As Integer
    Dim j As Integer
    
For j = AMIDASTROW To AMIDASTROW _
+ AMIDAROW - 1
        For i = 2 To Range("D2") * 2
            If Cells(j, i).Interior.Color = RGB(0, 0, 255) Then
                Cells(j, i).Interior.Color = RGB(255, 0, 0)
            End If
        Next
Next
End Sub

Private Sub ExAtariStart(btnno As Long)
    Dim lcol As Long
    Dim lrow As Long
    
    'あみだ範囲のクリア
    ExAmidaClear
    
    '開始位置
    lrow = AMIDASTROW
    lcol = 1 + (btnno * 2) - 1

    Do
        Cells(lrow, lcol).Interior.Color = RGB(0, 0, 255)
        '横線のチェック
If Cells(lrow, lcol + 1).Interior.Color = RGB(255, 0, 0) Then
            Cells(lrow, lcol + 1).Interior.Color = RGB(0, 0, 255)
            '右へ
            lcol = lcol + 2
ElseIf Cells(lrow, lcol - 1).Interior.Color = RGB(255, 0, 0) Then
            Cells(lrow, lcol - 1).Interior.Color = RGB(0, 0, 255)
            '左へ
            lcol = lcol - 2
        End If
        Cells(lrow, lcol).Interior.Color = RGB(0, 0, 255)
        
        '次の行へ
        lrow = lrow + 1
        Cells(lrow, lcol).Select
        '終了チェック
        If lrow >= AMIDASTROW + AMIDAROW Then
            Exit Do
        End If
        Cells(lrow, lcol).Select
        Sleep 50
    Loop
    Cells(lrow, lcol).Select
    '当たりチェック
    If Cells(lrow, lcol) = "当たり" Then
        Cells(AMIDASTROW - 3, 1 + (btnno * 2) - 1). HorizontalAlignment = xlHAlignCenter
        Cells(AMIDASTROW - 3, 1 + (btnno * 2) - 1) = "当たり"
        Beep
        Sleep 1000
        Range("A1").Select
        Cells(AMIDASTROW - 2, 1 + (btnno * 2) - 1).Select
    Else
        Cells(AMIDASTROW - 3, 1 + (btnno * 2) - 1). HorizontalAlignment = xlHAlignCenter
        Cells(AMIDASTROW - 3, 1 + (btnno * 2) - 1) = "セーフ"
        Sleep 700
        Range("A1").Select
        Cells(AMIDASTROW - 2, 1 + (btnno * 2) - 1).Select
    End If

End Sub