Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

12969 / 76738

←次へ　｜　前へ→


	【69280】Re:VBAプログラミング

UO3 - 11/6/17(金) 16:35 -


	引用なし

	パスワード

▼文哉さん：

こんにちは

やはり、GetAsyncKeyState　が不安定です。
で、何回もキーを押すとＰＣ全体が、変になる現象もでましたので、この制御は撤回し
かわりに「おやすみ」プロシジャを用意しました。これを実行すれば、千鳥足の徘徊は
終了します。（マクロショートカットキーに登録して実行すると操作しやすいかも）

で、本体の「酔っ払い」ですが、第三版として、リバイス。
移動方向の制御は変更していませんが、GetAsyncKeyState制御の撤回に加え、
千鳥足イメージを、すこし強調してみました。

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim StopLoop As Boolean

Sub 酔っ払い3()
　　Dim myRGB As Integer
　　Dim myRow As Long, myCol As Long
　　Dim x As Long, y As Long, z As Long, i As Long
　　Dim rtn As Long, svColor As Long, mySeq As Long
　　Dim myTrace As Long
　　
　　Randomize
　　Cells.Clear
　　myTrace = RGB(&HC0, &HC0, &HC0) '軌跡の色　薄いグレー
　　StopLoop = False
　　
　　Do
　　　　If StopLoop Then Exit Do
　　
　　　　For i = 1 To 30
　　　　　　With ActiveCell
　　　　　　　　myRow = .Row
　　　　　　　　myCol = .Column
　　　　　　End With
　　
　　　　　　z = Int((5 - 1 + 1) * Rnd + 1)
　　
　　　　　　Select Case z
　　　　
　　　　　　　　Case 1
　　　　　　　　　　x = 0: y = 0
　　　　　　　　Case 2
　　　　　　　　　　x = 0: y = 1
　　　　　　　　Case 3
　　　　　　　　　　x = 0: y = -1
　　　　　　　　Case 4
　　　　　　　　　　x = 1: y = 0
　　　　　　　　Case 5
　　　　　　　　　　x = -1: y = 0
　　　　　　End Select
　　
　　　　　　If myRow + y < 1 Or myRow + y > Rows.Count Then y = 0
　　　　　　If myCol + x < 1 Or myCol + x > Columns.Count Then x = 0
　　　　　　
　　　　　　With ActiveCell
　　　　　　　　.Interior.Color = myTrace
　　　　　　　　.Offset(y, x).Activate
　　　　　　End With
　　　　　　
　　　　　　With ActiveCell
　　　　　　　　mySeq = mySeq + 1
　　　　　　　　.Value = mySeq
　　　　　　　　.ShrinkToFit = True '縮小して全てを表示
　　　　　　　　.Font.Color = RGB(255, 255, 255) '文字色は白抜き
　　　　　　　　.Interior.Color = vbBlack
　　　　　　End With
　　　　　　
　　　　　　Sleep 100
　　　　　　DoEvents
　　　　　　
　　　　Next
　　　　
　　　　With ActiveCell

　　　　　　For i = 1 To 20
　　　　　　　　.Interior.Color = vbWhite
　　　　　　　　Sleep 20
　　　　　　　　DoEvents
　　　　　　　　.Interior.Color = vbBlack
　　　　　　　　Sleep 20
　　　　　　　　DoEvents
　　　　　　Next
　　　
　　　　　　Sleep 500
　　　　　　DoEvents

　　　　End With
　　　　
　　Loop
　
　　With ActiveCell
　　　　.Value = "轟沈　爆睡"
　　End With
　
End Sub

Sub おやすみ()
　　StopLoop = True
End Sub

1 hits

▼

【69270】VBAプログラミング 文哉 11/6/17(金) 6:07