じゃんけんゲーム（ドット絵）【ExcelVBA】

【Excel×VBA】ボタンを押してじゃんけんをするゲームを作成

使用したサンプルコード

---

'WindowsAPIの押されたキーを判定する機能
Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Integer
'実行中断用Sleep
Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)
Public Sub Game()

'設定用のシート
Dim setsh As Worksheet
Set setsh = Worksheets("data")

'ゲーム用のシート
Dim gamesh As Worksheet
Set gamesh = Worksheets("game")

'吹き出しをセットする
Dim hantei As Shape
Set hantei = ActiveSheet.Shapes("吹き出し")

'自分の数値
Dim player As Integer: player = 0

'敵の数値
Dim enemy As Integer

'じゃんけん！と出す
hantei.TextFrame.Characters.Text = "じゃんけん！"

'ボタンが押されるまで繰り返し
Do While player = 0

'押されたキーを判定する
If GetAsyncKeyState(37) <> 0 Then
'左を押した場合
player = 1
ElseIf GetAsyncKeyState(38) <> 0 Then
'上キーを押した場合
player = 2
ElseIf GetAsyncKeyState(39) <> 0 Then
'右キーを押した場合
player = 3
End If

'間隔と制御を渡す
Sleep 10
DoEvents

Loop

'ぽんを入れる
hantei.TextFrame.Characters.Text = "ぽん！"

'敵の数値を決める(１から３の間の乱数）
enemy = Application.WorksheetFunction.RandBetween(1, 3)

'数値に応じてドット絵を変更する　自分
setsh.Range(setsh.Cells(1, (player - 1) * 12 + 1), setsh.Cells(12, player * 12)).Copy gamesh.Range("A1")

'数値に応じてドット絵を変更する　敵
setsh.Range(setsh.Cells(1, (enemy - 1) * 12 + 1), setsh.Cells(12, enemy * 12)).Copy gamesh.Range("M1")

'ちょっと感覚を開ける
Sleep 500

'勝ち負けの判定
Select Case player
'敵と一緒だったら
Case enemy
'あいこの処理
hantei.TextFrame.Characters.Text = "あいこ"
Case 1
If enemy = 2 Then
'勝ちの処理
hantei.TextFrame.Characters.Text = "かち"
Else
'負けの処理
hantei.TextFrame.Characters.Text = "負け"
End If
Case 2
If enemy = 3 Then
'勝ちの処理
hantei.TextFrame.Characters.Text = "かち"
Else
'負けの処理
hantei.TextFrame.Characters.Text = "負け"
End If
Case 3
If enemy = 1 Then
'勝ちの処理
hantei.TextFrame.Characters.Text = "かち"
Else
'負けの処理
hantei.TextFrame.Characters.Text = "負け"
End If
End Select
End Sub