Question

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

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

将箭头键绑定

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

另一个用绿色绘制细胞并将其来回移动的宏：

{{1}}

当我启动代码来回移动单元格时，允许移动标记单元格的宏停止工作。我做错了什么？是否可以将它们都起作用？

MyMarkedCell定义如下：

{{1}}

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

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

1 个答案: