Option
Explicit
Public
Function
GetDropDown(Sh
As
Object
,
ByVal
Target
As
Range,
Optional
ReInit
As
Boolean
)
As
CommandBar
Const
C_POPUP_NAME
As
String
=
"__myMainPopup"
Dim
objPopup
As
CommandBar
For
Each
objPopup
In
Application.CommandBars
If
objPopup.Name = C_POPUP_NAME
Then
Exit
For
Next
If
Not
objPopup
Is
Nothing
And
ReInit
Then
Call
objPopup.Delete
Set
objPopup =
Nothing
End
If
If
objPopup
Is
Nothing
Then
Set
objPopup = Application.CommandBars.Add(C_POPUP_NAME, msoBarPopup, ,
True
)
With
objPopup.Controls.Add(msoControlComboBox, Temporary:=
True
)
.OnAction =
"Popup_OnAction"
.Caption =
"Item1-1"
.Tag =
"cboSelection1"
Call
.AddItem(
"SubItem1"
)
Call
.AddItem(
"SubItem2"
)
Call
.AddItem(
"SubItem3"
)
End
With
With
objPopup.Controls.Add(msoControlButton, Temporary:=
True
)
.OnAction =
"Popup_OnAction"
.Caption =
"Item1-2"
.Tag =
"btnAction1"
End
With
With
objPopup.Controls.Add(msoControlPopup, Temporary:=
True
)
.Caption =
"Item1-3"
.Tag =
"mnuSub1"
With
.Controls
With
.Add(msoControlButton, Temporary:=
True
)
.OnAction =
"Popup_OnAction"
.Caption =
"Item1-3-1"
.Tag =
"btnAction1-1"
End
With
End
With
End
With
End
If
Set
GetDropDown = objPopup
End
Function
Public
Sub
Popup_OnAction()
With
CommandBars.ActionControl
If
.Type = msoControlComboBox
Then
MsgBox .Tag &
" { Text = '"
& .Text &
"' }"
Else
MsgBox .Tag
End
If
End
With
End
Sub