| |
みなさん初めまして。
Windows7にてExcel2007を使ってVBAでプログラミングをしているかなたんといいます。
まずは、リバーシのプログラムを組んでいたときの話です。
(初めに書いておきます。 これは半分前置きのような話です。)
対戦が終わった最後、どちらが勝ったのかを比べるために以下の方法をとりました。
----------------------------------------------------------------------
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub 判定()
MsgBox "どっちが勝ったか比べてみましょう。", vbOKOnly, "リバーシ"
Dim Bc As Byte, Bm As Byte, Bi As Byte, Bb As Boolean, Wc As Byte, Wm As Byte, Wi As Byte, Wb As Boolean
Bc = 1
Bb = True
Wc = 1
Wb = True
For R = 1 To 8 '盤面のこまをすべて緑に変える。
For C = 1 To 8
ActiveSheet.Shapes("N" & R & "_" & C).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 17
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 17
Next
Next '1.
MsgBox "どっちが勝ったのでしょう？", vbOKOnly, "リバーシ"
Again:
Sleep 100
If Bc <= Range("K5") Then '黒が取ったこまの数だけ行う
Bm = Bc Mod 8
If Bm = 0 Then
Bm = 8
Bi = Int(Bc / 8)
Else
Bi = Int(Bc / 8) + 1
End If
ActiveSheet.Shapes("N" & Bi & "_" & Bm).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 8
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 8 '2.
Bc = Bc + 1
Else
Bb = False 'もう黒のこまはないと言う
End If
If Wc <= Range("K7") Then '白がとったこまの数だけ行う
Wm = Wc Mod 8
If Wm = 0 Then
Wm = 1
Wi = (9 - Int(Wc / 8))
Else
Wm = (9 - Wm)
Wi = (9 - (Int(Wc / 8) + 1))
End If
ActiveSheet.Shapes("N" & Wi & "_" & Wm).Select
Selection.ShapeRange.Line.ForeColor.SchemeColor = 8
Selection.ShapeRange.Fill.ForeColor.SchemeColor = 9 '3.
Wc = Wc + 1
Else
Wb = False 'もう白のこまはないと言う
End If
If Bb = True Or Wb = True Then 'もしどちらかのこまがあれば
GoTo Again 'Againに戻ってもう一度行う
End If
Application.Run "勝ち.勝ち"
End Sub
----------------------------------------------------------------------
すると、盤面を緑に変える前(あるいはその動作が飛ばされたあと？)に2のメッセージボックスが出てきてしまい、黒と白のこまを並べる部分では、カーソルが変わって処理中なのはわかるのですが、盤面が変わらずに4のメッセージボックスが出てきてしまいました。
そこで、このコードの先頭(Subの次の行)に
Application.ScreenUpdating = True
と書いてみたのですが、それでも盤面が変わらずにメッセージボックスが出てくるだけでした。
なので、1.2.3.のあとに↑のコードを書いたところ、今度は盤面が変わってからメッセージボックスが出るようになりました。
そのときは、「VBAが画面の更新をサボったんだなぁ」と勝手に思っていました。
今神経衰弱を作ろうと思っていて、このApplication.ScreenUpdatingであれ？っと思ったことがあるので質問させてください。
(今回はこちらが本題です。)
シャッフルを次の方法でさせています。
-----------------------------------------------------------------------
Sub 切る()
Application.ScreenUpdating = False
Dim T As Byte, i(3) As Byte
Dim Memo(1 To 52), Mark(3) As String, JQ(11 To 12) As String
Mark(0) = "ダイヤ"
Mark(1) = "ハート"
Mark(2) = "スペード"
Mark(3) = "クラブ"
JQ(11) = "J"
JQ(12) = "Q"
Dim R As Byte, C As Byte
Randomize
i(0) = Int(52 * Rnd) + 1 '最初の数字を選ぶ
i(1) = Int(i(0) / 13)
i(2) = i(0) Mod 13
If i(2) = 0 Then '選ばれた数字によって配置するカードを決める
Memo(1) = Mark(i(1) - 1) & "のK"
Worksheets(1).Cells(2, 2) = Mark(i(1) - 1) & "のK"
Worksheets(1).Cells(3, 2) = "K"
ElseIf i(2) >= 11 Then
Memo(1) = Mark(i(1)) & "の" & JQ(i(2))
Worksheets(1).Cells(2, 2) = Mark(i(1)) & "の" & JQ(i(2))
Worksheets(1).Cells(3, 2) = JQ(i(2))
Else
Memo(1) = Mark(i(1)) & "の" & i(2)
Worksheets(1).Cells(2, 2) = Mark(i(1)) & "の" & i(2)
Worksheets(1).Cells(3, 2) = i(2)
End If
Application.ScreenUpdating = False
Worksheets(1).Shapes(Memo(1)).Top = 67.5 '決められたカードの位置を変更する
Worksheets(1).Shapes(Memo(1)).Left = 45
Application.ScreenUpdating = False
For T = 2 To 52 '上と同じようなことを繰り返す
Again:
i(0) = Int(52 * Rnd) + 1
i(1) = Int(i(0) / 13)
i(2) = i(0) Mod 13
If i(2) = 0 Then
Memo(T) = Mark(i(1) - 1) & "のK"
ElseIf i(2) >= 11 Then
Memo(T) = Mark(i(1)) & "の" & JQ(i(2))
Else
Memo(T) = Mark(i(1)) & "の" & i(2)
End If
For i(0) = 1 To (T - 1)
If Memo(T) = Memo(i(0)) Then 'もし今選んだカードが一度選ばれていたならば
GoTo Again 'Againに戻ってもう一度選びなおす
End If
Next
If (T Mod 13 = 0) Then
R = 2 * Int(T / 13)
C = 50
Else
R = 2 * Int(T / 13) + 2
C = (4 * (T Mod 13) - 3) + 1
End If
If i(2) = 0 Then
Worksheets(1).Cells(R, C) = Mark(i(1) - 1) & "のK"
Worksheets(1).Cells((R + 1), C) = "K"
ElseIf i(2) >= 11 Then
Worksheets(1).Cells(R, C) = Mark(i(1)) & "の" & JQ(i(2))
Worksheets(1).Cells((R + 1), C) = JQ(i(2))
Else
Worksheets(1).Cells(R, C) = Mark(i(1)) & "の" & i(2)
Worksheets(1).Cells((R + 1), C) = i(2)
End If
Application.ScreenUpdating = False
Worksheets(1).Shapes(Memo(T)).Top = 67.5 * (R / 2)
Worksheets(1).Shapes(Memo(T)).Left = 45 * (Int((C - 2) / 4) + 1)
Application.ScreenUpdating = False
Next
Application.ScreenUpdating = True
End Sub
-----------------------------------------------------------------------
最初は"Application.ScreenUpdating = False"等はどこにも書かずにいたのですが、画面がちらついて背面に配置していたカードの数字が書いてあるものが、カードの絵柄の前にチラッと出てきてしまっているように見えてしまいます。
そこで、次に先頭に"Application.ScreenUpdating = False"を書いたのですが、それでも状況が変わりません。
そこで、ためしに↑のコードのようにカードを移動させる前と移動させたあとにも書き加えたのですが、それでも状況は変わりません。
そこで、最後に"Application.ScreenUpdating = True"を書き加えたのですが、やはりそれでも状況はまったっく変わりません。
"Application.ScreenUpdating = False"は画面の更新を抑制するためのコードだと思っているのですが、なぜ↑のコードでは抑制されないのでしょうか？
私なりにGoogleで調べてみようと思い、検索の候補(?)にあがっていた「application.screenupdating false 効かない」というので調べてみたのですが、いろいろと見てみましたがなぜこのコードでこうなってしまうのかがわかりませんでした。
シャッフルするときにどこに何があるのかが見えてしまわないようにシャッフルさせたいのですが、どのように書き直せばそういうことができるのでしょうか？
どなたか知っている人がいましたら、どうかよろしくお願いいたします。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
