另一个宏正在运行时,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中一次只能运行一个过程.另一种方法是使用GetAsyncKeyStateAPI

这是一个例子.运行以下代码时,绿色单元格将开始移动.当您按下该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