Excel VBA onkey宏在另一个宏运行时工作

Question

我有一个宏，可以让您用箭头键移动标记的单元格。 这是下移

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 

这描绘在绿色电池和移动来回另一个宏代码：

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键时，它会提示你所按的键名。只需将消息框替换为相关的程序即可。

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