Excel Activex 列表框可在选择同一单元格时打开和关闭,而无需先点击另一个单元格

Excel Activex Listbox to open and close on selection of same cell without needing to click out onto another cell first

此代码在单击单元格 A2 时显示 ListBox1,在第二次单击 A2 或不再 selected 时隐藏它。 select 离子输出到 A2。

问题是在A2点击一次打开一次关闭后,必须点击另一个单元格才能再次点击A2才能产生ListBox的感知切换效果。

我曾尝试在 End If 之前重复 Application.EnableEvents = False [A3].Select Application.EnableEvents = True 但是当尝试 select sheet 上的任何其他单元格时, 只有 A3 是 selected.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With ActiveSheet.ListBox1
        If Target(1).Address = "$A" And .Visible = False Then
            .Visible = True
            Application.EnableEvents = False
            [A3].Select
            Application.EnableEvents = True
        Else
            .Visible = False
            For I = 0 To .ListCount - 1
                If .Selected(I) Then txt = txt & ", " & .List(I)
            Next
            [A2] = Mid(txt, 2)  'remove first comma and output to A2 cell
        End If
    End With
End Sub

问题已更新以包含提供的答案,同时合并上面的部分代码以将 ListBox selections 输出到单元格 A2。新问题是,每次关闭 ListBox 时,已经生成的 select 离子会继续在单元格 A2 中繁殖,而不是仅添加新的 select 离子。

Option Explicit

Dim SelectCell As Boolean
Dim i As Long
Dim txt As String

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With ActiveSheet.ListBox1
        If Target(1).Address = "$A" And .Visible = False Then
            .Visible = True
            Application.EnableEvents = False
            [A3].Select
            Application.EnableEvents = True
            SelectCell = True
        Else
            .Visible = False
            
            For i = 0 To .ListCount - 1
                If .Selected(i) Then txt = txt & ", " & .List(i)
            Next
            [A2] = Mid(txt, 2)  'remove first comma and output to A2 cell
            
            
            If SelectCell = True Then
                Application.EnableEvents = False
                [A3].Select
                Application.EnableEvents = True
                SelectCell = False
            End If
        End If
    End With
End Sub

Yes this works however when you click any other cell in the sheet it keeps selecting cell A3. I will clarify question. Thanks – aye cee 1 min ago

这是您正在尝试的吗?

Option Explicit

Dim SelectCell As Boolean

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With ActiveSheet.ListBox1
        If Target(1).Address = "$A" And .Visible = False Then
            .Visible = True
            Application.EnableEvents = False
            [A3].Select
            Application.EnableEvents = True
            SelectCell = True
        Else
            .Visible = False
            If SelectCell = True Then
                Application.EnableEvents = False
                [A3].Select
                Application.EnableEvents = True
                SelectCell = False
            End If
        End If
    End With
End Sub

The Listbox should open and close endless times by clicking A2 or close by clicking outside, while also allowing selection of other cells on the sheet. Yes I included all code. On your end can you repeatedly click A2 to open close without selecting any other cell? – aye cee 2 mins ago

正是这样做的。看到这个

备选方案

Worksheet_BeforeDoubleClickWorksheet_SelectionChange 结合使用。看到这个。现在 ListBox1 将在您每次双击 A2 时显示,并在选择任何其他单元格时隐藏。

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target(1).Address = "$A" And ListBox1.Visible = False Then
        ListBox1.Visible = True
        Cancel = True
    Else
        ListBox1.Visible = False
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If ListBox1.Visible = True Then ListBox1.Visible = False
End Sub

我看到你已经有了解决方案。然而,就其价值而言,这是另一种方法。我认为它可以让您更灵活地控制 ListBox 在显示时显示的内容。

Option Explicit

Private Const Trigger       As String = "A2"

Private Sub ListBox1_LostFocus()
    ' 238

    Dim Txt     As String
    Dim i       As Integer
    
    With ListBox1
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                If Len(Txt) Then Txt = Txt & ","
                Txt = Txt & .List(i)
            End If
        Next i
        Range(Trigger).Value = Txt
    End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ' 238
    
    With ListBox1
        If Target.Address(0, 0) = Trigger Then
            .Visible = True
            .ListFillRange = "P2:P9"
        Else
            .Visible = False
        End If
    End With
End Sub

在上述设置中,当用户单击 A2 时会显示列表框。然后,他可以通过单击列表框外的任意位置来进行选择并将其传输到 A2。但是,如果他单击 A2,他可以看到他的选择及其对 A2 的转录,然后返回到列表框以更改选择。