Option Explicit
Private WithEvents xlApp As Application
Private WithEvents Combbox As MSForms.ComboBox
Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As LongPtr)
#Else
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSrc As Any, ByVal ByteLen As LongPtr)
Private Sub Workbook_Open()
Set xlApp = Application
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.Names("PrveSh").Delete
End Sub
Private Sub Combbox_Change()
MsgBox "You selected : " & Combbox.Value
End Sub
Private Sub xlApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
With Application
If Target.Column = 1& Then
On Error Resume Next
.Sheets([PrveSh]).OLEObjects("Dynamic_ComboBox").Delete
.Names("PrveSh").Delete
On Error GoTo 0
Set Combbox = Sh.OLEObjects.Add( _
ClassType:="Forms.ComboBox.1", _
Left:=Target.Left, _
Top:=Target.Cells(1).Top, _
Width:=150&, Height:=20&).Object
Combbox.Name = "Dynamic_ComboBox"
.Names.Add "PrveSh", Sh.Name, False
.OnTime Now, "'" & Me.CodeName & ".Populate_And_Hook_ComboBox " & ObjPtr(Combbox) & "'"
End If
End With
End Sub
Private Sub Populate_And_Hook_ComboBox(ByVal Ptr As LongPtr)
Const PTR_SIZE = 8&
#Else
Const PTR_SIZE = 4&
Dim oTmpObj As Object, i As Long
Set xlApp = Application
Call CopyMemory(oTmpObj, Ptr, PTR_SIZE)
Set Combbox = oTmpObj
Call CopyMemory(oTmpObj, 0&, PTR_SIZE)
For i = 1 To 10&
Combbox.AddItem i
Next i
End Sub