ExcelVBAで、キーボード方向キーを押したら、その方向に塗りつぶし

質問

ExcelVBAで、キーボード方向キーを押したら、その方向に塗りつぶしたセルを移動させたいです。

とりあえず、以下のようなマクロを組んだのですが、
方向キーを一度でも押すと、押した方向の彼方へ一瞬で飛んでいってしまいます。

Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long 'キー入力のAPI

'一番最初に塗りつぶすセル
set 塗りつぶし = Range("B2,C2")　

do
塗りつぶし.Interior.ColorIndex = 3 '赤く塗りつぶし

'左入力したら塗りつぶしセルを左に移動
If GetAsyncKeyState(37) Then
　　　　塗りつぶし.Interior.ColorIndex = 0
　　　 Set 塗りつぶし = 塗りつぶし.Offset(0, -1)
End If

'右入力したら塗りつぶしセルを右に移動
　If GetAsyncKeyState(39) <> 0 Then
塗りつぶし.Interior.ColorIndex = 0
Set 塗りつぶし = 塗りつぶし.Offset(0, 1)
End If

Loop

予想なんですが、一度でもキーを入力したら、
その方向へずっと入力しているようになっている
と思うのですが、どう直して良いか分かりません。

宜しくお願いします。

回答No.4

mimeu · ベストアンサー

> ExcelVBAで、キーボード方向キーを押したら、
> その方向に塗りつぶしたセルを移動させたい

何のためにこのマクロを作るのかによって答えは全然違ってきますが、
　　目的：マクロのお勉強で、背景色をセル移動してみたい
　　セルを移動：　セルのデータではなく背景色だけ移動する
と勝手に仮定してアドバイスをします　　　（＾＿＾）

まず、この目的で GetAsyncKeyState API を使うのは不適切でしょう。
その理由は、いくつか試されたら簡単にわかります。

で、例えばこんな感じでもイケます
以下のコードを目的のシートのコードペイン（モジュールではなくて）
に貼り付けてください。
なお、この例では事前に目的のシートの "D6" を選択し、背景色をつけておいてから試します。

Option Explicit

Dim 初期化済み As Boolean
Dim 直前の色つきセル As Range
Dim 色番号 As Variant

Private Sub 初期設定()
Set 直前の色つきセル = Range("D6") ' ★★★ ここは適当にアレンジしてね
色番号 = 直前の色つきセル.Interior.ColorIndex
初期化済み = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim r0 As Long, c0 As Long, r1 As Long, c1 As Long
If Not 初期化済み Then 初期設定
r0 = Abs(Target.Row - 直前の色つきセル.Row)
c0 = Abs(Target.Column - 直前の色つきセル.Column)
If r0 > 1 Or c0 > 1 Then Exit Sub ' 方向キー以外で移動したときは処理しない
直前の色つきセル.Interior.ColorIndex = xlColorIndexNone
Target.Interior.ColorIndex = 色番号
Set 直前の色つきセル = Target
End Sub

以下、余談ですが
Ｅｘｃｅｌ上ではなく　Ｖｉｓｕａｌ Ｂａｓｉｃ ２００８ですとか、その他本格的なプログラム言語でつくる Ｗｉｎｄｏｗ ならキー入力イベントがありますから、それで方向キー入力をイベントドリブンで処理できます。
しかしＥｘｃｅｌ上にはその機能がないので、方向キーなど、キー入力に応じて何かするというのは、難しいとおもいます。
なので、ご質問のようなことをなさるには本格的なプログラム言語をお使いになることを薦めます。

回答No.3

Wendy02

ご質問のコードは、イベントの一種で、プロ用のコードです。失礼ですが、前回の質問内容から、そのコードを扱うような方には見えないのですが。

Win32 API関数などには、PrivateやPablic などのステートメントを入れたほうが良いですし、意図的にしているなら別ですが、ColorIndex = 0　や2バイトの変数は関心しません。

私の記憶だけですが、GetAsyncKeyState(37) = 0　は、キーが押されていないという意味ですが、逆に[→]キー以外を押しているという意味にもなりますから、このキーを監視し続けても、解放されないはずです。もちろん、元のコードは、イベントの一種ですから、無限ループが発生させますが、それを利用するなら、RaiseEvent やWin32 API関数のタイマー処理で、イベントの監視が必要なはずです。ここの掲示板では、そのような内容は私にとっても敷居が高いです。RaiseEvent ならともかく、Do ～ Loop型のイベントは、、私はもう何年も作ったことがありません。

もう少しレベルを下げて作ってみました。なお、ActiveCell は、どこにあっても、関係がありません。

'//
'シートモジュール
Private Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long
Private Const VK_LEFT = &H25 '[←] 37
Private Const VK_UP = &H26 '[↑] 38
Private Const VK_RIGHT = &H27 '[→] 39
Private Const VK_DOWN = &H28 '[↓] 40
Private PArea As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
　Const mCOLOR As Integer = 3
　If PArea Is Nothing Then　'初期化
　　Me.UsedRange.Interior.ColorIndex = xlColorIndexNone
　　Set PArea = Range("B2:C2")
　End If

　If GetAsyncKeyState(VK_LEFT) <> 0 Then
　If PArea.Cells(1).Column = 1 Then Exit Sub
　　PArea.Interior.ColorIndex = xlColorIndexNone
　　Set PArea = PArea.Offset(0, -1)
　　APaint PArea, mCOLOR
　ElseIf GetAsyncKeyState(VK_UP) <> 0 Then
　If PArea.Cells(1).Row = 1 Then Exit Sub
　　PArea.Interior.ColorIndex = xlColorIndexNone
　　Set PArea = PArea.Offset(-1, 0)
　　APaint PArea, mCOLOR
　ElseIf GetAsyncKeyState(VK_RIGHT) <> 0 Then
　If PArea.Cells(PArea.Cells.Count).Column = Columns.Count Then Exit Sub
　　PArea.Interior.ColorIndex = xlColorIndexNone
　　Set PArea = PArea.Offset(0, 1)
　　APaint PArea, mCOLOR
　ElseIf GetAsyncKeyState(VK_DOWN) <> 0 Then
　If PArea.Cells(PArea.Cells.Count).Row = Rows.Count Then Exit Sub
　　PArea.Interior.ColorIndex = xlColorIndexNone
　　Set PArea = PArea.Offset(1, 0)
　　APaint PArea, mCOLOR
　End If

End Sub
Private Sub APaint(rng As Range, clIdx As Integer)
　With rng
　　 .Interior.ColorIndex = xlColorIndexNone
　　 .Interior.ColorIndex = clIdx
　End With
End Sub

回答No.2

keithin

あなたのマクロは意図的に無限ループさせていますが，そのある時に←キーを押します。
あなたが←キーを押して「左入力したら塗りつぶしセルを左に移動」のIFが作動した後，そのキーから完全に指が離れるまで（つまりGetAsyncKeyState(37) が 0 になるまで）の間をそのDo Loopで回し続けて，「←キーが押されました・押されています」を消費し尽くさせます。これが「キーボードバッファをクリア」の意味です。

＞例えば以下の書き方だとエラーが出てしまいます。

関数に値を入れようとしても，エラーになります。
1+1 = 2
と書いて「１＋１に２を入れる」と書いても，ナンデスカ？となってしまいます。
１＋１が２と等しいのか等しくないのか，IF 1+1 = 2 then　のように判断式として使えば問題有りません。

回答No.1

keithin

１．端っこに辿り着いたら，それ以上先は無いのだから先に行かせないようにすること。
２．キーボードバッファをクリアすること

作成例：
Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long 'キー入力のAPI

sub macro1(_RIght)
'一番最初に塗りつぶすセル
set 塗りつぶし = Range("B2,C2")　

do
塗りつぶし.Interior.ColorIndex = 3 '赤く塗りつぶし

'左入力したら塗りつぶしセルを左に移動
　If GetAsyncKeyState(37) Then
　　　塗りつぶし.Interior.ColorIndex = 0
　　　if 塗りつぶし.column > 1
　　　　Set 塗りつぶし = 塗りつぶし.Offset(0, -1)
　　　end if
　End If

Do Until GetAsyncKeyState(37) = 0
Loop

補足

ありがとうございます。
問題なくできたのですが、
キーボードバッファの部分がイマイチ分かりません。

Do Until GetAsyncKeyState(37) = 0
Loop

例えば以下の書き方だとエラーが出てしまいます。
GetAsyncKeyState(37) = 0
バッファをクリアという意味も、もし宜しかったら教えて下さい。