Excel VBA質問箱 IV

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

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


12968 / 76734 ←次へ | 前へ→

【69277】Re:VBAプログラミング
発言  UO3  - 11/6/17(金) 12:29 -

引用なし
パスワード
   ▼文哉 さん:

一応、色合いの多段階変化【以外】の改訂版です。
もうちょっと、よろよろかんを出してみましたが、さて、どうでしょう。
斜め移動をなくした結果、移動選択肢が少なくなって、動きが少なくなっています。

なお、途中で Shiftキーをおして終了させるようにしています。
ただ、すぐにキーを認識してくれる場合となかなか認識してくれない場合が
あります。ポンポンと2回ほど押すと認識確立が高くなりますが、あまりに
何回もおしていると、Windowsからメッセージがでるかもしれません。

どうしてもとまらない場合は、任意の文字を入力してください。
スペースでもいいです。要は、編集モードにしてマクロ実行を強制的に中断。

Option Explicit

Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long

Sub 酔っ払い2()
  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
  
  Randomize
  Cells.Clear
  myRGB = 223 '開始時の色合い
  
  Do
    rtn = GetAsyncKeyState(16) 'Shiftキー
    If rtn <> 0 Then Exit Do
    
    Sleep 500
    DoEvents
    
    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
    
    ActiveCell.Offset(y, x).Activate
    
    With ActiveCell
      svColor = RGB(myRGB, myRGB, myRGB)
      For i = 1 To 10
        
        .Interior.Color = svColor
        Sleep 30
        DoEvents
        .Interior.Color = vbWhite
        Sleep 30
        DoEvents
        
      Next
      
      Sleep 500
      .Interior.Color = svColor
      mySeq = mySeq + 1
      .Value = mySeq
      .ShrinkToFit = True '縮小して全てを表示
      .Font.Color = RGB(255, 255, 255) '文字色は白抜き
      myRGB = myRGB - 1 '次の色用

    End With
  Loop
  
  With ActiveCell
    .Value = "轟沈 爆睡"
    .Interior.Color = vbBlack
  End With
  
End Sub
7 hits

【69270】VBAプログラミング 文哉 11/6/17(金) 6:07 質問
【69271】Re:VBAプログラミング UO3 11/6/17(金) 6:41 発言
【69273】Re:VBAプログラミング Jaka 11/6/17(金) 9:45 発言
【69278】あ〜、なんとなく解った。 Jaka 11/6/17(金) 12:54 発言
【69274】Re:VBAプログラミング SS 11/6/17(金) 9:49 発言
【69279】Re:VBAプログラミング SS 11/6/17(金) 13:07 発言
【69276】Re:VBAプログラミング UO3 11/6/17(金) 11:45 発言
【69277】Re:VBAプログラミング UO3 11/6/17(金) 12:29 発言
【69280】Re:VBAプログラミング UO3 11/6/17(金) 16:35 発言

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