带有数据验证列表的组合框

时间:2018-09-10 00:05:33

标签: excel

我遵循this guide制作了一个组合框,该组合框用数据验证列表替换了单元格的常规选择菜单。但是,它始终显示为空白。我的数据验证如下:=Sheet!$L$2:INDEX(Sheet!$L$2:$L$80;SUMPRODUCT(--(Sheet!$L$2:$L$80<>""))),我粘贴的代码是这样:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
On Error GoTo errHandler

If Target.Count > 1 Then GoTo exitHandler

Set cboTemp = ws.OLEObjects("TempCombo")
  On Error Resume Next
If cboTemp.Visible = True Then
  With cboTemp
    .Top = 10
    .Left = 10
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
    .Value = ""
  End With
End If

  On Error GoTo errHandler
  If Target.Validation.Type = 3 Then
    'if the cell contains a data validation list
    Application.EnableEvents = False
    'get the data validation formula
    str = Target.Validation.Formula1
    str = Right(str, Len(str) - 1)
    With cboTemp
      'show the combobox with the list
      .Visible = True
      .Left = Target.Left
      .Top = Target.Top
      .Width = Target.Width + 15
      .Height = Target.Height + 5
      .ListFillRange = ws.Range(str).Address
      .LinkedCell = Target.Address
    End With
    cboTemp.Activate
    'open the drop down list automatically
    Me.TempCombo.DropDown 
  End If

exitHandler:
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Exit Sub
errHandler:
  Resume exitHandler 

End Sub 
'====================================
'Optional code to move to next cell if Tab or Enter are pressed
'from code by Ted Lanham
'***NOTE: if KeyDown causes problems, change to KeyUp
'Table with numbers for other keys such as Right Arrow (39)
'https://msdn.microsoft.com/en-us/library/aa243025%28v=vs.60%29.aspx

Private Sub TempCombo_KeyDown(ByVal _
        KeyCode As MSForms.ReturnInteger, _
        ByVal Shift As Integer)
    Select Case KeyCode
        Case 9 'Tab 
            ActiveCell.Offset(0, 1).Activate
        Case 13 'Enter 
            ActiveCell.Offset(1, 0).Activate
        Case Else
            'do nothing
    End Select
End Sub

为了清楚起见:该框出现并消失,只是没有任何条目。我不确定错误在哪里,但我认为我的验证可能太复杂了?

0 个答案:

没有答案