Потерять фокус из ComboBox с помощью Control + Arrowkeys [Excel]

Question

Я настраиваю рабочую таблицу, которая содержит код VBA, который помещает ComboBox в любую ячейку, в которую я перехожу, и которая использует Datavalidation.

Всякий раз, когда я иду в ячейку, которая использует датализацию, он активирует ComboBox и перемещает ComboBox в мою выбранную ячейку. Когда я выбираю новую ячейку, она перемещает ComboBox на новую позицию или, если ячейка не содержит DataValidation, она скрывается.

Проблема в том, что у меня есть около 1000 строк и 2 столбцов, по которым я легко хочу перемещаться, и все они будут вводить любой из опций списка, которые я использую для своего подтверждения данных. Поэтому я предпочел бы иметь возможность перемещаться вверх и вниз по моим строкам, а также вправо и влево между столбцами без использования моей мыши.

Сейчас я не могу этого сделать. Когда я захожу в ComboBox, он автоматически позволяет мне печатать его, и если я продолжаю нажимать клавиши со стрелками, я просто прокручиваю свой список ComboBox.

Я успешно добавил код, который позволяет мне нажимать клавишу ВВОД, чтобы перейти вниз, и клавишу Tab, чтобы перейти вправо, но это не сработает, если я изменю кнопку на одну из клавиш со стрелками, и я не уверен, как ее отредактировать, чтобы я мог перейти вверх или слева. Без этого кода я могу использовать только «выход» или щелчок мышью, чтобы снять фокусировку с этой ячейки.

Моим предпочтительным решением было бы добавить оператор if где-то в коде, который требует, чтобы я удерживал Control или что-то перемещалось без активации кода. Например

Активировать код ComboBox IF Control не нажата И если текущая ячейка содержит анализ данных.

Это код, который я использую.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Update by Extendoffice: 2018/9/21
    Dim xCombox As OLEObject
    Dim xStr As String
    Dim xWs As Worksheet
    Dim xArr

    Set xWs = Application.ActiveSheet
    On Error Resume Next
    Set xCombox = xWs.OLEObjects("TempCombo")
    With xCombox
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
    End With
    If Target.Validation.Type = 3 Then
        Target.Validation.InCellDropdown = False
        Cancel = True
        xStr = Target.Validation.Formula1
        xStr = Right(xStr, Len(xStr) - 1)
        If xStr = "" Then Exit Sub
        With xCombox
            .Visible = True
            .Left = Target.Left
            .Top = Target.Top
            .Width = Target.Width + 5
            .Height = Target.Height + 5
            .ListFillRange = xStr
            If .ListFillRange = "" Then
                xArr = Split(xStr, ",")
                Me.TempCombo.List = xArr
            End If
            .LinkedCell = Target.Address
        End With
        xCombox.Activate

    End If
End Sub
Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Select Case KeyCode
        Case 9
            Application.ActiveCell.Offset(0, 1).Activate
        Case 13
            Application.ActiveCell.Offset(1, 0).Activate
    End Select
End Sub

Answer 1

Прежде всего, хороший код.

Во-вторых, попробуйте следующее в вашем методе KeyDown:

Private Sub TempCombo_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

    Dim celltemp(1) As String

    Select Case KeyCode

        Case 38
            celltemp(0) = Application.ActiveCell.Cells(0, 1).Address
            celltemp(1) = CStr(Application.ActiveCell.Cells(0, 1).Value)

        Case 40
            celltemp(0) = Application.ActiveCell.Cells(2, 1).Address
            celltemp(1) = CStr(Application.ActiveCell.Cells(2, 1).Value)

        Case 39
            celltemp(0) = Application.ActiveCell.Cells(1, 2).Address
            celltemp(1) = CStr(Application.ActiveCell.Cells(1, 2).Value)

        Case 37
            celltemp(0) = Application.ActiveCell.Cells(1, 0).Address
            celltemp(1) = CStr(Application.ActiveCell.Cells(1, 0).Value)

    End Select

    TempCombo.Enabled = False

    ActiveSheet.Range(celltemp(0)).Activate

    If CStr(ActiveCell.Value) <> celltemp(1) Then _
    ActiveCell.Value = celltemp(1)

    TempCombo.Enabled = True

End Sub

Я думаю, у него ожидаемое поведение.

Как вы можете видеть, на моей клавиатуре коды клавиш для стрелок находятся от 37 до 40. Я не уверен, что это одинаково на всех клавиатурах, но вы можете просто адаптировать его, чтобы он работал. Используйте следующую команду перед оператором Select Case, чтобы получить ваши коды, если они отличались от моих:

debug.print KeyCode

Если вы хотите, чтобы это выполнялось только при нажатии клавиши управления, есть способ сделать это: использование виртуальных клавиш и включение в метод KeyDown итерации, которая позволяет остальной части кода выполнять только при нажатии клавиши, которую вы нажимаете. хочу (в этом случае: ключ управления).

Есть способ, которым я это сделал (я включаю полный код здесь):

'declare virtual key event listener ---------------------------------------

#If VBA7 Then
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
            (ByVal vKey As Long) As Integer
#Else
    Private Declare Function GetAsyncKeyState Lib "user32" _
            (ByVal vKey As Long) As Integer
#End If
'--------------------------------------------------------------------------

'declare virtual key constants -------------------------------------------

Private SWITCH As Boolean

Private Const VK_CTRL = &H11 'CONTROL key
Private Const VK_LEFT = &H25 'LEFT ARROW key
Private Const VK_UP = &H26 'UP ARROW key
Private Const VK_RIGHT = &H27 'RIGHT ARROW key
Private Const VK_DOWN = &H28 'DOWN ARROW key
'--------------------------------------------------------------------------

'For more information about virtual key interactions with VBA visit the following link:
'    https://wellsr.com/vba/2017/excel/GetAsyncKeyState-vba-to-wait-until-a-key-is-pressed/


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim xCombox As OLEObject
    Dim xStr As String
    Dim xWs As Worksheet
    Dim xArr

    Set xWs = Application.ActiveSheet
    On Error Resume Next
    Set xCombox = xWs.OLEObjects("TempCombo")

    With xCombox

        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False

    End With

    If Target.Validation.Type = 3 Then

        Target.Validation.InCellDropdown = False
        Cancel = True
        xStr = Target.Validation.Formula1
        xStr = RIGHT(xStr, Len(xStr) - 1)
        If xStr = "" Then Exit Sub

        With xCombox

            .Visible = True

            If Not SWITCH Then

                .LEFT = Target.LEFT
                .Top = Target.Top

            End If

            .Width = Target.Width + 5
            .Height = Target.Height + 5
            .ListFillRange = xStr

            If .ListFillRange = "" Then

                xArr = Split(xStr, ",")
                Me.TempCombo.List = xArr

            End If

            .LinkedCell = Target.Address

        End With

        xCombox.Activate

    End If

End Sub


Private Sub TempCombo_KeyDown(ByVal keycode As MSForms.ReturnInteger, ByVal Shift As Integer)

    If Not SWITCH Then

        Do While GetAsyncKeyState(VK_CTRL) <> 0

            If GetAsyncKeyState(VK_LEFT) Then
                ActiveSheet.Range(Application.ActiveCell.Cells(1, 0).Address).Activate
                Exit Do

            ElseIf GetAsyncKeyState(VK_RIGHT) Then
                ActiveSheet.Range(Application.ActiveCell.Cells(1, 2).Address).Activate
                Exit Do

            ElseIf GetAsyncKeyState(VK_UP) Then
                ActiveSheet.Range(Application.ActiveCell.Cells(0, 1).Address).Activate
                Exit Do

            ElseIf GetAsyncKeyState(VK_DOWN) Then
                ActiveSheet.Range(Application.ActiveCell.Cells(2, 1).Address).Activate
                Exit Do

            End If

        Loop

    Else

        SWITCH = False

    End If

    If keycode = 17 Then SWITCH = True

End Sub

Вы можете скачать полный файл здесь: Управляемые ключом списки ActiveX - тест - (GitHub)

Привет