Question

我正在设置一个工作表，其中包含一个VBA代码，该代码将ComboBox放置在我要使用Datavalidation的任何单元格中。

每当我转到使用datavalidation的单元格时，它将启用ComboBox并将ComboBox移至我选择的单元格。当我选择一个新的单元格时，它将ComboBox移到新位置，或者如果该单元格不包含DataValidation，它就会被隐藏起来。

问题是我有大约1000行和2列，我很容易浏览它们，所有这些都将输入我用于数据验证的任何列表选项。因此，我希望能够使用鼠标在行之间上下左右导航，而无需使用鼠标。

现在我无法做到这一点。当我转到ComboBox时，它会自动让我键入它，如果我再继续按箭头键，我会滚动浏览我的ComboBox列表。

我已成功添加了一个代码，该代码可让我按Enter向下移动，然后按Tab键向右移动，但是如果我将按钮更改为一个箭头键，并且无法确定如何进行编辑，那么就可以正常工作了或离开。没有该代码，我只能使用“退出”或单击鼠标来使该单元格失去焦点。

我更喜欢的解决方案是在代码中的某处添加if语句，该语句要求我保留Control或在不激活代码的情况下四处移动。例如

激活组合框代码如果未按下控制键如果当前单元格包含Datavalidation。

这是我正在使用的代码。

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

我认为它具有预期的行为。

如您所见，在我的键盘上，箭头的KeyCodes从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

您可以在此处下载完整文件：Key-controlled ActiveX comboboxes--test--(GitHub)

问候

使用Control +箭头键[Excel]从ComboBox失去焦点

1 个答案: