プロが教えるわが家の防犯対策術!

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


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

宜しくお願いします。

A 回答 (4件)

> 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


以下、余談ですが
Excel上ではなく Visual Basic 2008ですとか、その他本格的なプログラム言語でつくる Window ならキー入力イベントがありますから、それで方向キー入力をイベントドリブンで処理できます。
しかしExcel上にはその機能がないので、方向キーなど、キー入力に応じて何かするというのは、難しいとおもいます。
なので、ご質問のようなことをなさるには本格的なプログラム言語をお使いになることを薦めます。
    • good
    • 1

ご質問のコードは、イベントの一種で、プロ用のコードです。

失礼ですが、前回の質問内容から、そのコードを扱うような方には見えないのですが。

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
    • good
    • 1

あなたのマクロは意図的に無限ループさせていますが,そのある時に←キーを押します。


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


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

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

1.端っこに辿り着いたら,それ以上先は無いのだから先に行かせないようにすること。


2.キーボードバッファをクリアすること

作成例:
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
バッファをクリアという意味も、もし宜しかったら教えて下さい。

補足日時:2010/06/14 02:11
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています