Excel实战技巧73：使用组合框控件仿数据验证下拉列表

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range,Cancel As Boolean)
    '如果单元格在列A中
    If Not Intersect(Target,Columns("A")) Is Nothing Then
        '调用过程
        Call AddDropList(Target)
        Cancel = True
    End If
End Sub

'添加仿下拉列表的窗体控件
Sub AddDropList(Target As Range)
    Dim drp As DropDown
    Dim varItems As Variant
    Dim i As Integer
   
    '创建列表项数组
    varItems = Array("东区", "西区", "南区", "北区")
   
    '添加下拉控件
    With Target
        Set drp =Sheet1.DropDowns.Add(.Left, .Top, .Width, .Height)
    End With
   
    '设置要运行的过程并填充列表
    With drp
        .OnAction ="EnterInfo"
        For i =LBound(varItems) To UBound(varItems)
            .AddItem varItems(i)
        Next i
    End With
End Sub
 
'输入所选项后删除控件
Private Sub EnterInfo()
    With Sheet1.DropDowns(Application.Caller)
        .TopLeftCell.Value =.List(.ListIndex)
        .Delete
    End With
End Sub