zredbaron
02-14-2017, 12:43 PM
Hi. I'm attempting to create and hide an ActiveX controls ListBox whenever a user clicks a cell and clicks out of it, respectively. The object has been created manually in the spreadsheet (not via VBA). Attached.
The desired behavior:
When a user clicks on a cell (E7:E107), to show a ListBox for a user to select an option.
Clicking another cell (outside of range) should hide the ListBox
The undesired behavior:
When a user clicks on a cell (E7:E107), the ListBox appears, but it doesn't respond to any clicks
Clicking another cell (outside of range) hides the ListBox
Clicking back into (E7:E107), same behavior... no response to clicks.
HOWEVER... clicking from the range back into the same range (from E10 to E15, for example) DOES WORK and enables the ListBox for mouse listening
I've tried several combinations trying to come up with a magic combination to no avail. What am I missing?
Option Explicit
Dim fillRng As Range
Public RngRoster As Range, RngCategory As Range, RngCategoryList As Range
Public RefRoster As String, RefCategory As String, RefCategoryList As String
Public Sub Initialize_Variables()
Application.EnableEvents = True
On Error Resume Next
Set RngRoster = ThisWorkbook.Names("RangeRoster").RefersToRange
Set RngCategory = ThisWorkbook.Names("RangeCategory").RefersToRange
Set RngCategoryList = ThisWorkbook.Names("RangeCategoryList").RefersToRange
RefRoster = ActiveWorkbook.Names("RangeRoster")
RefCategory = ActiveWorkbook.Names("RangeCategory")
RefCategoryList = ActiveWorkbook.Names("RangeCategoryList")
On Error GoTo 0
End Sub
Private Sub ListBoxDemo_Click()
'MsgBox "list box click"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Call Initialize_Variables
'Tests for click in Range E7:E107
If Not Intersect(Target, RngCategory) Is Nothing Then
MsgBox "A category assignment was added or changed!" & " (" & Target.Address & ")"
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call Initialize_Variables
Dim LBColors As MSForms.ListBox
Dim LBobj As OLEObject
Dim i As Long
Set LBobj = Me.OLEObjects("ListBoxDemo")
Set LBColors = LBobj.Object
If Not Intersect(Target, RngCategory) Is Nothing Then
Set fillRng = Target
With LBobj
.Left = fillRng.Left
.Top = fillRng.Top
.Width = fillRng.Width
.Locked = False
.Visible = True
.Enabled = True
.Select
End With
Else
LBobj.Visible = False
End If
ActiveSheet.Select
Application.EnableEvents = True
End Sub
Thanks so much in advance!
18372
The desired behavior:
When a user clicks on a cell (E7:E107), to show a ListBox for a user to select an option.
Clicking another cell (outside of range) should hide the ListBox
The undesired behavior:
When a user clicks on a cell (E7:E107), the ListBox appears, but it doesn't respond to any clicks
Clicking another cell (outside of range) hides the ListBox
Clicking back into (E7:E107), same behavior... no response to clicks.
HOWEVER... clicking from the range back into the same range (from E10 to E15, for example) DOES WORK and enables the ListBox for mouse listening
I've tried several combinations trying to come up with a magic combination to no avail. What am I missing?
Option Explicit
Dim fillRng As Range
Public RngRoster As Range, RngCategory As Range, RngCategoryList As Range
Public RefRoster As String, RefCategory As String, RefCategoryList As String
Public Sub Initialize_Variables()
Application.EnableEvents = True
On Error Resume Next
Set RngRoster = ThisWorkbook.Names("RangeRoster").RefersToRange
Set RngCategory = ThisWorkbook.Names("RangeCategory").RefersToRange
Set RngCategoryList = ThisWorkbook.Names("RangeCategoryList").RefersToRange
RefRoster = ActiveWorkbook.Names("RangeRoster")
RefCategory = ActiveWorkbook.Names("RangeCategory")
RefCategoryList = ActiveWorkbook.Names("RangeCategoryList")
On Error GoTo 0
End Sub
Private Sub ListBoxDemo_Click()
'MsgBox "list box click"
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Call Initialize_Variables
'Tests for click in Range E7:E107
If Not Intersect(Target, RngCategory) Is Nothing Then
MsgBox "A category assignment was added or changed!" & " (" & Target.Address & ")"
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call Initialize_Variables
Dim LBColors As MSForms.ListBox
Dim LBobj As OLEObject
Dim i As Long
Set LBobj = Me.OLEObjects("ListBoxDemo")
Set LBColors = LBobj.Object
If Not Intersect(Target, RngCategory) Is Nothing Then
Set fillRng = Target
With LBobj
.Left = fillRng.Left
.Top = fillRng.Top
.Width = fillRng.Width
.Locked = False
.Visible = True
.Enabled = True
.Select
End With
Else
LBobj.Visible = False
End If
ActiveSheet.Select
Application.EnableEvents = True
End Sub
Thanks so much in advance!
18372