vba - 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绑定(bind)了

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

这是一个例子。当您运行以下代码时，绿色单元格将开始移动。当您按下箭头键时，它会提示您按下的键的名称。只需用相关程序替换消息框即可。

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