Excel VBA onkeymacros在另一个macros运行时工作

我有一个macros，可以让你用箭头键移动标记的单元格。 这是将其向下移动的代码

Sub MoveMarkedDown() Dim noDo As Boolean With myMarkedCell Select Case .Row Case Is >= 36 noDo = True Case 35 With .Offset(1, 0) If (.Interior.ColorIndex = 3) Or IsBlockCell(.Cells) Then noDo = True End If End With Case Else With .Offset(1, 0) If IsBlockCell(.Cells) Or ((.Interior.ColorIndex = 3) And IsBlockCell(.Offset(1, 0).Cells)) Then noDo = True End If End With End Select End With If noDo Then Beep Else MoveMarkedCell 1, 0 End If End Sub 

我用application.onkey绑定了他们的箭头键

 Sub test() Application.OnKey "{LEFT}", "MoveMarkedLeft" Application.OnKey "{DOWN}", "MoveMarkedDown" Application.OnKey "{RIGHT}", "MoveMarkedRight" Application.OnKey "{UP}", "MoveMarkedUp" End Sub 

另一个macros观描绘了一个绿色的细胞，并来回移动它：

 Declare Sub Sleep Lib "kernel32" (ByVal dwMillisecons As Long) Private Sub Button1_Click() Move ''start macro button End Sub Sub Move() gr = 1 st = 1 While Cells(2, 2) = 0 If st > 1 Then Cells(5, st - 1).Clear End If Cells(5, st + 1).Clear Cells(5, st).Interior.Color = vbGreen st = st + gr If st > 48 Then gr = -1 End If If st < 2 Then gr = 1 End If Sleep 100 DoEvents Wend End Sub 

当我启动移动单元格的代码时，可以让标记的单元格停止工作。 我做错了什么？ 是否有可能做到这两个工作？

MyMarkedCell定义如下：

 Sub MoveMarkedCell(VMove As Long, HMove As Long) With ActiveSheet.MarkedCell .Value = vbNullString Set ActiveSheet.MarkedCell = .Offset(VMove, HMove) End With With ActiveSheet.MarkedCell .Value = "X" If .Interior.ColorIndex = 3 Then .Interior.ColorIndex = xlNone If (.Column + HMove) * (.Row + VMove) <> 0 Then .Offset(VMove, HMove).Interior.ColorIndex = 3 End If Application.Goto .Cells, False End With End Sub Function myMarkedCell() As Range If ActiveSheet.MarkedCell Is Nothing Then ActiveSheet.Worksheet_Activate End If Set myMarkedCell = ActiveSheet.MarkedCell End Function 

Answer 1

您不能像这样使用Application.OnKey ，因为在VBA中，一次只能运行一个程序。 另一种方法是使用GetAsyncKeyState API

这是一个例子。 当你运行下面的代码，绿色单元格将开始移动。 而当你按下Arrow键，它会提示你所按的键的名称。 只需将消息框replace为相关的程序即可。

 Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long Const VK_LEFT As Long = 37 Const VK_DOWN As Long = 40 Const VK_RIGHT As Long = 39 Const VK_UP As Long = 38 Sub Move() gr = 1: st = 1 While Cells(2, 2) = 0 '~~> Do the checks here and direct them to the relevant sub If GetAsyncKeyState(VK_LEFT) <> 0 Then MsgBox "Left Arrow Pressed" 'MoveMarkedLeft Exit Sub ElseIf GetAsyncKeyState(VK_RIGHT) <> 0 Then MsgBox "Right Arrow Pressed" Exit Sub ElseIf GetAsyncKeyState(VK_UP) <> 0 Then MsgBox "Up Arrow Pressed" Exit Sub ElseIf GetAsyncKeyState(VK_DOWN) <> 0 Then MsgBox "Down Arrow Pressed" Exit Sub End If If st > 1 Then Cells(5, st - 1).Clear Cells(5, st + 1).Clear Cells(5, st).Interior.Color = vbGreen st = st + gr If st > 48 Then gr = -1 If st < 2 Then gr = 1 Sleep 100 DoEvents Wend End Sub