- お手本マクロ
- 課題ファイル（途中データ）
- 各章の完成ソースコード
などを提供しています！
（エクセル兄さん：たてばやし淳）
Contents
第0章 お手本マクロ＆課題ファイル
本コースで配布している「お手本マクロ」「課題ファイル」をダウンロードしていただけます。
・お手本VBAゲーム1
・お手本VBAゲーム2
・VBA_Game課題
それぞれを以下からダウンロードすることができます。
講義の学習にご利用下さい。
第1章スタート時点の課題ファイル
第1章完了時点のソースコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 |
Option Explicit '変数の宣言を強制する（※今は気にしないでください） Sub left() Range("M1").Value = "leftpic" End Sub Sub right() Range("M1").Value = "rightpic" End Sub Sub up() Range("M1").Value = "backpic" End Sub Sub down() Range("M1").Value = "frontpic" End Sub |
第2章スタート時点の課題ファイル
※第1章から課題を進めている方は、ダウンロードの必要はありません。
第2章完了時点のソースコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 |
Option Explicit '変数の宣言を強制する（※今は気にしないでください） Sub left() Range("M1").Value = "leftpic" Selection.Offset(0, -1).Select ActiveSheet.Shapes("playerpic").Top = Selection.Top ActiveSheet.Shapes("playerpic").left = Selection.left End Sub Sub right() Range("M1").Value = "rightpic" Selection.Offset(0, 1).Select ActiveSheet.Shapes("playerpic").Top = Selection.Top ActiveSheet.Shapes("playerpic").left = Selection.left End Sub Sub up() Range("M1").Value = "backpic" Selection.Offset(-1, 0).Select ActiveSheet.Shapes("playerpic").Top = Selection.Top ActiveSheet.Shapes("playerpic").left = Selection.left End Sub Sub down() Range("M1").Value = "frontpic" Selection.Offset(1, 0).Select ActiveSheet.Shapes("playerpic").Top = Selection.Top ActiveSheet.Shapes("playerpic").left = Selection.left End Sub |
第3章スタート時点の課題ファイル
【ここから始める方へ】
第3章からの途中ファイルをダウンロードすることができます。
※前の章から課題を進めている方は、ダウンロードの必要はありません。
※ただし、講義では、「Sub Left()」などのプロシージャ名の頭文字が大文字に変更（left→Leftなど）されていますので、ご注意下さい。
第3章完了時点のソースコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 |
Option Explicit '変数の宣言を強制する（※今は気にしないでください） Sub left() Range("M1").Value = "leftpic" Selection.Offset(0, -1).Select ActiveSheet.Shapes("playerpic").Top = Selection.Top ActiveSheet.Shapes("playerpic").left = Selection.left End Sub Sub right() Range("M1").Value = "rightpic" Selection.Offset(0, 1).Select ActiveSheet.Shapes("playerpic").Top = Selection.Top ActiveSheet.Shapes("playerpic").left = Selection.left End Sub Sub up() Range("M1").Value = "backpic" Selection.Offset(-1, 0).Select ActiveSheet.Shapes("playerpic").Top = Selection.Top ActiveSheet.Shapes("playerpic").left = Selection.left End Sub Sub down() Range("M1").Value = "frontpic" Selection.Offset(1, 0).Select ActiveSheet.Shapes("playerpic").Top = Selection.Top ActiveSheet.Shapes("playerpic").left = Selection.left End Sub |
第4章スタート時点の課題ファイル
※第4章は、必ず以下のファイルを使用して下さい。
（理由：）レクチャーを理解するために必要なコメント行が書いてあるからです。
レクチャー内では、そのコメント行を目安にVBAのコードを書くように進めています。必ずご利用下さい。
第4章完了時点のソースコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 |
Option Explicit '変数の宣言を強制する（※今は気にしないでください） Sub Left() '画像をleftpic（左向き）に変更 Range("M1").Value = "leftpic" '1列目より左には行けないよう条件分岐 If Selection.Column > 1 Then 'プレイヤーの1つ先≠赤(3)なら If Selection.Offset(0, -1).Interior.ColorIndex <> 3 Then 'プレイヤーが1つ進む処理 Selection.Offset(0, -1).Select End If End If '選択セルのTopとLeftへ画像を移動する ActiveSheet.Shapes("playerpic").Top = Selection.Top ActiveSheet.Shapes("playerpic").Left = Selection.Left End Sub Sub Right() '画像をleftpic（右向き）に変更 Range("M1").Value = "rightpic" 'プレイヤーの1つ先≠赤(3) If Selection.Offset(0, 1).Interior.ColorIndex <> 3 Then 'プレイヤーが1つ進む処理 Selection.Offset(0, 1).Select End If '選択セルのTopとLeftへ画像を移動する ActiveSheet.Shapes("playerpic").Top = Selection.Top ActiveSheet.Shapes("playerpic").Left = Selection.Left End Sub Sub Up() '画像をbackpic（上向き）に変更 Range("M1").Value = "backpic" '1行目より上には行けないよう条件分岐 If Selection.Row > 1 Then 'プレイヤーの1つ先≠赤(3) If Selection.Offset(-1, 0).Interior.ColorIndex <> 3 Then 'プレイヤーが1つ進む処理 Selection.Offset(-1, 0).Select End If End If '選択セルのTopとLeftへ画像を移動する ActiveSheet.Shapes("playerpic").Top = Selection.Top ActiveSheet.Shapes("playerpic").Left = Selection.Left End Sub Sub Down() '画像をfrontpic（下向き）に変更 Range("M1").Value = "frontpic" 'プレイヤーの1つ先≠赤(3) If Selection.Offset(1, 0).Interior.ColorIndex <> 3 Then 'プレイヤーが1つ進む処理 Selection.Offset(1, 0).Select End If '選択セルのTopとLeftへ画像を移動する ActiveSheet.Shapes("playerpic").Top = Selection.Top ActiveSheet.Shapes("playerpic").Left = Selection.Left End Sub |
第5章スタート時点の課題ファイル
※第5章は、必ず以下のファイルを使用して下さい。
（理由：）
・レクチャーをより理解しやすいよう、コメント行を書き加えています。
・「リセットボタン」を作ってあります。リセットボタンの仕組みについても、講義内で解説しています。
第5章完了時点のソースコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 |
Option Explicit '変数の宣言を強制する（※今は気にしないでください） '-------------------------- 'リセットボタンの処理 Sub Reset() 'シート「stage1」のA1:J9をコピーする→シート「game」のA1:J9へ Worksheets("stage1").Range("A1:J9").Copy Worksheets("game").Range("A1:J9") '「game」のセルB2を選択 Worksheets("game").Range("B2").Select '選択セルのTopとLeftへ画像を移動 ActiveSheet.Shapes("playerpic").Top = Selection.Top ActiveSheet.Shapes("playerpic").Left = Selection.Left End Sub '-------------------------- '左ボタンを押したときの処理 Sub Left() '画像をleftpic（左向き）に変更 Call PlayerRotate("leftpic") '左向きの衝突判定など Call CheckCollision(0, -1) '選択セルのTopとLeftへ画像を移動する Call PlayerMove End Sub '-------------------------- '右ボタンを押したときの処理 Sub Right() '画像をrightpic（右向き）に変更 Call PlayerRotate("rightpic") '右向きの衝突判定など Call CheckCollision(0, 1) '選択セルのTopとLeftへ画像を移動する Call PlayerMove End Sub '-------------------------- '上ボタンを押したときの処理 Sub Up() '画像をbackpic（上向き）に変更 Call PlayerRotate("backpic") '衝突判定など Call CheckCollision(-1, 0) '選択セルのTopとLeftへ画像を移動する Call PlayerMove End Sub '-------------------------- '下ボタンを押したときの処理 Sub Down() '画像をforntpic（下向き）に変更 Call PlayerRotate("frontpic") '衝突判定など Call CheckCollision(1, 0) '選択セルのTopとLeftへ画像を移動する Call PlayerMove End Sub 'プレイヤーの画像を移動する Sub PlayerMove() ActiveSheet.Shapes("playerpic").Top = Selection.Top ActiveSheet.Shapes("playerpic").Left = Selection.Left End Sub 'プレイヤー画像の向きを変える Sub PlayerRotate(ByVal strPic As String) Range("M1").Value = strPic End Sub '衝突などを判定する Sub CheckCollision(ByVal row, col As Long) 'プレイヤーの1つ先≠赤(3)なら If Selection.Offset(row, col).Interior.ColorIndex <> 3 Then '1つ先が黄色(6)なら If Selection.Offset(row, col).Interior.ColorIndex = 6 Then '2つ先が黒(1)であるなら If Selection.Offset(row * 2, col * 2).Interior.ColorIndex = 1 Then '黄色ブロックが1つ進む処理 Selection.Offset(row, col).Interior.ColorIndex = 1 Selection.Offset(row * 2, col * 2).Interior.ColorIndex = 6 'プレイヤーが1つ進む処理 Selection.Offset(row, col).Select Else 'そうでなければ '進めない End If Else 'そうでなければ 'プレイヤーが1つ進む処理 Selection.Offset(row, col).Select End If End If End Sub |
第6章スタート時点の課題ファイル
【ここから始める方へ】
第6章からの途中ファイルをダウンロードすることができます。
※前の章から課題を進めている方は、ダウンロードの必要はありません。
第6章完了時点のソースコード
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 |
Option Explicit '宣言していない変数は使えないようにする '-------------------------- 'リセットボタンの処理 Sub Reset() 'シート「stage1」のA1:J9をコピーする→シート「game」のA1:J9へ Worksheets("stage1").Range("A1:J9").Copy Worksheets("game").Range("A1:J9") '「game」のセルB2を選択 Worksheets("game").Range("B2").Select '選択セルのTopとLeftへ画像を移動 ActiveSheet.Shapes("playerpic").Top = Selection.Top ActiveSheet.Shapes("playerpic").Left = Selection.Left 'ステージ番号を1に戻す Range("M8").Value = 1 End Sub '-------------------------- '左ボタンを押したときの処理 Sub Left() '画像をleftpic（左向き）に変更 Call PlayerRotate("leftpic") '左向きの衝突判定など Call CheckCollision(0, -1) '選択セルのTopとLeftへ画像を移動する Call PlayerMove 'ゴール判定 Call Goal End Sub '-------------------------- '右ボタンを押したときの処理 Sub Right() '画像をrightpic（右向き）に変更 Call PlayerRotate("rightpic") '右向きの衝突判定など Call CheckCollision(0, 1) '選択セルのTopとLeftへ画像を移動する Call PlayerMove 'ゴール判定 Call Goal End Sub '-------------------------- '上ボタンを押したときの処理 Sub Up() '画像をbackpic（上向き）に変更 Call PlayerRotate("backpic") '衝突判定など Call CheckCollision(-1, 0) '選択セルのTopとLeftへ画像を移動する Call PlayerMove 'ゴール判定 Call Goal End Sub '-------------------------- '下ボタンを押したときの処理 Sub Down() '画像をforntpic（下向き）に変更 Call PlayerRotate("frontpic") '衝突判定など Call CheckCollision(1, 0) '選択セルのTopとLeftへ画像を移動する Call PlayerMove 'ゴール判定 Call Goal End Sub 'プレイヤーの画像を移動する Sub PlayerMove() ActiveSheet.Shapes("playerpic").Top = Selection.Top ActiveSheet.Shapes("playerpic").Left = Selection.Left End Sub 'プレイヤー画像の向きを変える Sub PlayerRotate(ByVal strPic As String) Range("M1").Value = strPic End Sub '衝突などを判定する Sub CheckCollision(ByVal row, col As Long) 'プレイヤーの1つ先≠赤(3)なら If Selection.Offset(row, col).Interior.ColorIndex <> 3 Then '1つ先が黄色(6)なら If Selection.Offset(row, col).Interior.ColorIndex = 6 Then '2つ先が黒(1)であるなら If Selection.Offset(row * 2, col * 2).Interior.ColorIndex = 1 Then '黄色ブロックが1つ進む処理 Selection.Offset(row, col).Interior.ColorIndex = 1 Selection.Offset(row * 2, col * 2).Interior.ColorIndex = 6 'プレイヤーが1つ進む処理 Selection.Offset(row, col).Select Else 'そうでなければ '進めない End If Else 'そうでなければ 'プレイヤーが1つ進む処理 Selection.Offset(row, col).Select End If End If End Sub 'ゴール判定 Sub Goal() 'もしセルの値が3なら If Selection.Value = 3 Then 'ループで5回フラッシュする Dim i As Integer For i = 0 To 5 Range("壁").Interior.ColorIndex = 44 '黄色 Application.Wait [Now() + "0:00:00.1"] Range("壁").Interior.ColorIndex = 3 '赤 Application.Wait [Now() + "0:00:00.1"] Next i MsgBox "GOAL!!!" '---次のステージに移る '変数numに、ステージ番号を格納 Dim num As Integer num = Range("M8").Value 'numを+1する num = num + 1 'エラー回避 On Error GoTo NoStage 'シート「stagex」のA1:J9をコピーする→シート「game」のA1:J9へ Worksheets("stage" & num).Range("A1:J9").Copy Worksheets("game").Range("A1:J9") '「game」のセルB2を選択 Worksheets("game").Range("B2").Select 'プレイヤーの画像を移動する Call PlayerMove 'ステージ番号を書き換える Range("M8").Value = num Exit Sub 'エラーが起きた場合（次のステージが無い） NoStage: MsgBox "You Finished!!" End If End Sub |
