Dim cboTemp As OleObject 
Set cboTemp = ws.OLEObjects("combobox1") 
With cboTemp 
.Visible = True
 .Left = Target.Left 
.Top = Target.Top 
.Width = Target.Width +  13  
.Height = Target.Height +  2  
.LinkedCell = Target.Address 
End With

Private Sub CreateCombo()
    'On Error Resume Next
    Dim TempCombo                       As OLEObject
    Dim ws                              As Worksheet
    Set ws = ActiveSheet
    Set TempCombo = ws.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Left:= 1 , Top:= 1 , Width:= 0 , Height:= 0 )
    TempCombo.Name = "Combobox1"
    TempCombo.Visible =  0 
    TempCombo.PrintObject =  0   
End Sub

    Dim xl                              As Excel.Application
    Dim nb                              As Excel.Workbook
    Dim ws                              As Excel.Worksheet
    Dim cnn                             As ADODB.Connection
    Dim rst                             As ADODB.Recordset
    'Dim rs                              As dao.Recordset



    'TempCombo.Visible = 0
    'TempCombo.PrintObject = 0

    Set xl = CreateObject("Excel.application")
    Set nb = xl.Workbooks.Add    '("c:\Tralala.xls")
    Set ws = nb.ActiveSheet
    xl.Visible =  0 
    Dim x As MSForms.ComboBox, z        As OLEObject
    Const myCBName                      As String = "TempCombo"


    On Error GoTo  0 
    Set z = ws.OLEObjects.Add(ClassType:="forms.combobox.1", Link:=False, _
                              DisplayAsIcon:=False, Left:= 100 , Top:= 16 , Width:= 100 , Height:= 20 )
    z.Name = myCBName
    Set x = z.Object

    With x
        .ColumnCount =  1 
        ' .ColumnWidths = "1 in; 1 in; 1 in;"  'not needed - only 1 column
        .Font.Name = "Arial"
        .Font.Size =  10 
        .BackStyle =  0 
        .BorderStyle =  1 
        .DropButtonStyle =  1 
        .TextAlign =  1   ' 2 = Center 3 = Right
        .SpecialEffect =  0 
    End With


    nb.SaveAs "C:\TTT.xls"
    nb.Close
    xl.Workbooks.Close
    xl.Quit
    Set ws = Nothing
    ' rst.Close: Set rst = Nothing
    'cnn.Close: Set cnn = Nothing
    Set nb = Nothing
    Set xl = Nothing

Private Sub showCombo(ByVal Target As Range)
    Dim str                             As String
    Dim cboTemp                         As OLEObject
    Dim ws                              As Worksheet
    Set ws = ActiveSheet
    Set cboTemp = ws.OLEObjects("TempCombo")
    On Error Resume Next
    With cboTemp
        .ListFillRange = ""
        .LinkedCell = ""
        .Visible = False
    End With
    On Error GoTo errHandler
    If Target.Validation.Type =  3  Then
        Application.EnableEvents = False
        str = Target.Validation.Formula1
        Me.TempCombo.List = Split(str, ";")
        With cboTemp
            .Visible = True
            .Left = Target.Left
            .Top = Target.Top
            .Width = Target.Width +  15 
            .Height = Target.Height +  5 
            .LinkedCell = Target.Address
        End With
        cboTemp.Activate
    End If
errHandler:
    Application.EnableEvents = True
    Exit Sub
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim str                             As String
    Dim cboTemp                         As OLEObject
    Dim ws                              As Worksheet
    Set ws = ActiveSheet
    '
    Set cboTemp = ws.OLEObjects("TempCombo")
    On Error Resume Next
    If cboTemp.Visible = True Then
        With cboTemp
            .Top =  10 
            .Left =  10 
            .ListFillRange = ""
            .LinkedCell = ""
            .Visible = False
        End With
        Application.ScreenUpdating = True
    End If
    showCombo Target
errHandler:
    Application.EnableEvents = True
    Exit Sub
End Sub