Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


15156 / 76738 ←次へ | 前へ→

【67065】Application.ScreenUpdatingについての質問です。
質問  かなたん  - 10/10/30(土) 2:21 -

引用なし
パスワード
   みなさん初めまして。
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 効かない」というので調べてみたのですが、いろいろと見てみましたがなぜこのコードでこうなってしまうのかがわかりませんでした。
シャッフルするときにどこに何があるのかが見えてしまわないようにシャッフルさせたいのですが、どのように書き直せばそういうことができるのでしょうか?
どなたか知っている人がいましたら、どうかよろしくお願いいたします。

0 hits

【67065】Application.ScreenUpdatingについての質問です。 かなたん 10/10/30(土) 2:21 質問
【67069】Re:Application.ScreenUpdatingについての... SK63 10/10/30(土) 12:11 発言
【67072】Re:Application.ScreenUpdatingについての... かなたん 10/10/30(土) 12:28 回答
【67070】Re:Application.ScreenUpdatingについての... かなたん 10/10/30(土) 12:19 発言
【67071】Re:Application.ScreenUpdatingについての... SK63 10/10/30(土) 12:23 発言
【67073】Re:Application.ScreenUpdatingについての... かなたん 10/10/30(土) 12:33 回答
【67074】Re:Application.ScreenUpdatingについての... SK63 10/10/30(土) 12:50 回答
【67075】Re:Application.ScreenUpdatingについての... かなたん 10/10/30(土) 13:12 お礼
【67076】Re:Application.ScreenUpdatingについての... SK63 10/10/30(土) 16:34 発言

15156 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free