Question

我目前正在运行一个问题，我的代码设置要求组合框出现在我的工作表中存在数据验证的所有单元格中。这适用于一个工作表，但我希望在我的工作簿中为整套工作表进行此操作。以下是我目前正在运行的代码，我想知道我目前面临的问题是否有任何快速解决方案。谢谢！

'==========================
Private Sub Worksheet_BeforeDoubleClick _
  (ByVal Target As Range, _
    Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject

Dim ws As Worksheet
Set ws = Sheets("Test")

Set cboTemp = ws.OLEObjects("TempCombo")
  On Error Resume Next
  With cboTemp
  'clear and hide the combo box
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
  End With
On Error GoTo errHandler
  If Target.Validation.Type = 3 Then
    'if the cell contains
      'a data validation list
    Cancel = True
    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 + 5
      .Height = Target.Height + 5
      .ListFillRange = str
      .LinkedCell = Target.Address
    End With
    cboTemp.Activate
    'open the drop down list automatically
    Me.TempCombo.DropDown
  End If

errHandler:
  Application.EnableEvents = True
  Exit Sub

End Sub
'=========================================
Private Sub TempCombo_LostFocus()
  With Me.TempCombo
    .Top = 10
    .Left = 10
    .Width = 0
    .ListFillRange = ""
    .LinkedCell = ""
    .Visible = False
    .Value = ""
  End With
End Sub
 '====================================

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
'====================================

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
    Set Target = Range("A8")
    If Target = "" Then Exit Sub
    On Error GoTo Badname
    ActiveSheet.Name = Left(Target, 31)
    Exit Sub
Badname:
    MsgBox "Please revise the entry in A8." & Chr(13) _
    & "It appears to contain one or more " & Chr(13) _
    & "illegal characters." & Chr(13)
    Range("A8").Activate
End Sub

Answer 1

如果您希望在所有工作表中运行此代码，请使用Workbook_SheetBeforeDoubleClick事件代替Worksheet_BeforeDoubleClick。

假设： OLEObjects("TempCombo")名称在所有工作表中都相同。

    Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim str As String
    Dim cboTemp As OLEObject

    Dim ws As Worksheet
    Set ws = ThisWorkbook.ActiveSheet
        Set cboTemp = ws.OLEObjects("TempCombo")
          On Error Resume Next
          With cboTemp
          'clear and hide the combo box
            .ListFillRange = ""
            .LinkedCell = ""
            .Visible = False
          End With
        On Error GoTo errHandler
          If Target.Validation.Type = 3 Then
            'if the cell contains
              'a data validation list
            Cancel = True
            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 + 5
              .Height = Target.Height + 5
              .ListFillRange = str
              .LinkedCell = Target.Address
            End With
            cboTemp.Activate
            'open the drop down list automatically
            Me.TempCombo.DropDown
          End If

errHandler:
      Application.EnableEvents = True
      Exit Sub
    End Sub

在工作簿中添加自动填充组合框

1 个答案: