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