vba клавиша пауза / возобновление - переключение - PullRequest
0 голосов
/ 27 апреля 2020

если код - GetAsyncKeyState заменен на MsgBox, он работает нормально, однако, хотя ошибки нет, код не работает с GetAsyncKeyState.

или может ли команда / кнопка переключения работать с EXCEL VBA?

#If VBA7 Then
    'declare virtual key event listener
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
    (ByVal vKey As Long) As Integer
#Else
    'declare virtual key event listener
    Private Declare Function GetAsyncKeyState Lib "user32" _
    (ByVal vKey As Long) As Integer
#End If
Private Const VK_RA = &H27

Sub Hide_Next()

    Dim a           As Range
    Dim b           As Range

        Cells.EntireColumn.Hidden = True
        Columns("a").EntireColumn.Hidden = False
        If GetAsyncKeyState(vbKeyRight) Then
            Application.Goto Reference:=Range("a1"), Scroll:=True

            For Each a In Range("A2:A23").Cells
                If a.Value = Empty Then
                    a.EntireRow.Hidden = True
                End If
            Next a
        End If

        If GetAsyncKeyState(vbKeyRight) Then
            Columns("b").EntireColumn.Hidden = False
            For Each b In Range("B2:B23").Cells
                If b.Value <> Empty Then
                    b.EntireRow.Hidden = False
                End If
            Next b

        End If

        If GetAsyncKeyState(VK_RA) Then
            Cells.EntireColumn.Hidden = False
        End If
    End Sub

Рабочий код, пытается заменить MagBox на нажатие клавиши: Sub Hide_Next ()

Dim a           As Range
Dim b           As Range

        Cells.EntireColumn.Hidden = True
    Columns("a").EntireColumn.Hidden = False
    MsgBox "Pause-A"
        Application.Goto Reference:=Range("a1"), Scroll:=True

        For Each a In Range("A2:A23").Cells
            If a.Value = Empty Then
                a.EntireRow.Hidden = True
            End If
        Next a

    MsgBox "Pause-B"
        Columns("b").EntireColumn.Hidden = False
        For Each b In Range("B2:B23").Cells
            If b.Value <> Empty Then
                b.EntireRow.Hidden = False
            End If
        Next b

    'and so on for the next column ...

End Sub

Пример:

enter image description here

1 Ответ

0 голосов
/ 27 апреля 2020

В вашем коде происходят странные вещи.

  1. То, как это написано, заключается в том, что вам нужно будет нажимать клавишу со стрелкой вправо в тот момент, когда запускается эта подпрограмма. Это не абсурдно или что-то в этом роде, но вы не задаете в своем вопросе, чего вы ожидаете от этого кода.

  2. Вы проверяете 3 раза, нажата ли эта правая клавиша, и между каждой проверкой вы выполняете очень медленные действия, связанные с фронтальным / пользовательским интерфейсом, такие как скрытие строк и отображение столбцов. Если пользователь убирает палец с клавиши со стрелкой вправо, а Excel пытается измениться, следующий блок не будет выполнен.

  3. Вы проверяете, нажата ли стрелка вправо, используя обе клавиши vbKeyRight и VK_RA константа. Я не эксперт здесь, но кажется, что оба из них должны вернуть &H27 ... Я бы придерживался одного или другого, хотя для отладки.

Перезапись:

#If VBA7 Then
    'declare virtual key event listener
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
    (ByVal vKey As Long) As Integer
#Else
    'declare virtual key event listener
    Private Declare Function GetAsyncKeyState Lib "user32" _
    (ByVal vKey As Long) As Integer
#End If
Private Const VK_RA = &H27

Sub Hide_Next()

    Dim a As Range      
    Dim rightKeyDown As Boolean

    'Check if the right arrow key is being pressed before interacting with excel's slow UI. 
    If GetAsyncKeyState(VK_RA) Then
        rightKeyDown = True
    End If

    'hide all the columns, except column A before doing anything
    Cells.EntireColumn.Hidden = True
    Columns("a").EntireColumn.Hidden = False

    'Let's see if that right key was down
    If rightKeyDown Then        
        Application.Goto Reference:=Range("a1"), Scroll:=True
        For Each a In Range("A2:A23").Cells
            If a.Value = "" AND a.Offset(,1).Value = "" Then
                a.EntireRow.Hidden = True
            End If
        Next a
        Cells.EntireColumn.Hidden = False
    End If

End Sub

Вы также спрашиваете о кнопке переключения. Не ясно, каковы ваши намерения (что происходит между этими несколькими шагами?). Впрочем, кнопка переключения - это опция.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...