Excel VBA onkey宏在另一个宏运行时正常工作 [英] Excel VBA onkey macro to work while another macro is running

问题描述

我有一个宏，可让您使用箭头键在标记的单元格中移动. 这是将其向下移动的代码

I have a macro that lets you move marked cell around with arrow keys. This is the code to move it down

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

另一个宏，该宏将绿色绘制为一个单元格并来回移动:

And another macro that paints a cell in green and moves it back and forth:

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

当我启动将单元格来回移动的代码时，使您可以移动标记单元格的宏将停止工作.我做错了什么?它们都可以工作吗?

And when i launch the code that moves the cell back and forth the macro that lets you move marked cell stops working. What i did wrong? Is it possible to do them both work?

MyMarkedCell的定义如下:

MyMarkedCell is defined like this:

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

推荐答案

您不能像这样使用Application.OnKey，因为在VBA中一次只能运行一个过程.替代方法是使用GetAsyncKeyState API

You can't use Application.OnKey like that because in VBA only one procedure can be run at a time. The alternative is to use the GetAsyncKeyState API

这里是一个例子.当您运行以下代码时，绿色单元格将开始移动.并且当您按下Arrow键时，它将提示您按下的键的名称.只需将消息框替换为相关过程即可.

Here is an example. When you run the below code, the green cells will start moving. And when you press the Arrow key, it will prompt you the name of the key you pressed. Simply replace the message boxes with the relevant procedures.

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宏在另一个宏运行时正常工作的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！