Question

我已经从Contextures网站调整了以下代码，该代码将组合框功能添加到包含数据验证的单元格中。虽然组合框在他们应该的地方展示得很好，但我仍然面临着两个问题。首先，在组合数据验证和组合框的“D4”单元格中选择值后，我需要在工作簿中的“D4”单元格中的其他工作表上显示相同的值。不幸的是，在添加了组合框代码后，Workbook_SheetChange代码停止工作。我认为这是因为它现在无法在数据验证/组合框中找到Target。第二个问题是，即使应用了Application.ScreenUpdating，下面的Worksheet_SelectionChange代码也会导致屏幕闪烁。有没有办法摆脱它？我会很高兴任何解决方案。

修改

最后我设法找到了自己先发行的解决方案。我完全省略了Workbook_SheetChange事件，并替换为ComboShtHeader_KeyDown和ComboShtHeader_LostFocus事件，这两个事件都放在工作簿表中。这些宏确保单元格的值在按Tab键，Enter键或单击“D4”单元格外部时在所有工作表上更改。我将以下两个代码放在有人面临类似问题的情况下。

但Worksheet_SelectionChange代码中屏幕闪烁的另一个问题仍然存在。解决方案仍然受欢迎。： - ）

Private Sub ComboShtHeader_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'change "D4" cell value on all sheets on pressing TAB or ENTER

Dim ws1 As Worksheet, ws As Worksheet

Set ws1 = ActiveSheet

Select Case KeyCode
    Case 9 'Tab
        ActiveCell.Offset(0, 1).Activate
        For Each ws In Worksheets
            If ws.Name <> ws1.Name Then
                ws.Range(ActiveCell.Offset(0, -3).Address).Value = ActiveCell.Offset(0, -3).Value
            End If
        Next ws
    Case 13 'Enter
        ActiveCell.Offset(1, 0).Activate
        For Each ws In Worksheets
            If ws.Name <> ws1.Name Then
                ws.Range(ActiveCell.Offset(-1, 0).Address).Value = ActiveCell.Offset(-1, 0).Value
            End If
        Next ws
    Case Else
        'do nothing
End Select

End Sub

Private Sub ComboShtHeader_LostFocus()
'change "D4" cell value on all sheets on click outside "D4" cell 

Dim ws1 As Worksheet, ws As Worksheet

Set ws1 = ActiveSheet

For Each ws In Worksheets
    If ws.Name <> ws1.Name Then
        ws.Range("D4").Value = ws1.Range("D4").Value
    End If
Next ws

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim ws As Worksheet, ws2 As Worksheet
Dim ComHead As OLEObject, ComBody As OLEObject
Dim Str As String

Application.ScreenUpdating = False

On Error GoTo ErrHandler
Set ws = ActiveSheet
Set ws2 = Worksheets("lists")
Set ComHead = ws.OLEObjects("ComboShtHeader")
Set ComBody = ws.OLEObjects("ComboShtBody")

On Error Resume Next
If ComHead.Visible = True Then
    With ComHead
      .Top = 34.5
      .Left = 120
      .Width = 20
      .Height = 15
      .ListFillRange = ""
      .LinkedCell = ""
      .Visible = False
      .Value = ""
    End With
End If

On Error Resume Next
If ComBody.Visible = True Then
    With ComBody
      .Top = 34.5
      .Left = 146.75
      .Width = 20
      .Height = 15
      .ListFillRange = ""
      .LinkedCell = ""
      .Visible = False
      .Value = ""
    End With
End If

On Error GoTo ErrHandler
'If the cell contains a data validation list
If Target.Validation.Type = 3 Then
    If Target.Address = ws.Range("D4:F4").Address Then
        If Target.Count > 3 Then GoTo ExitHandler
        Application.EnableEvents = False
        'Get the data validation formula
        Str = Target.Validation.Formula1
        Str = Right(Str, Len(Str) - 1)

        With ComHead
          'Show the combobox with the validation list
          .Visible = True
          .Left = Target.Left
          .Top = Target.Top
          .Width = Target.Width + 15
          .Height = Target.Height
          .ListFillRange = ws2.Range(Str).Address(external:=True)
          .LinkedCell = Target.Address
        End With

        ComHead.Activate

        'Open the dropdown list automatically
        Me.ComboShtHeader.DropDown
    Else
        If Target.Count > 1 Then GoTo ExitHandler
        Application.EnableEvents = False
        'Get the data validation formula
        Str = Target.Validation.Formula1
        Str = Right(Str, Len(Str) - 1)

        With ComBody
          'Show the combobox with the validation list
          .Visible = True
          .Left = Target.Left
          .Top = Target.Top
          .Width = Target.Width + 15
          .Height = Target.Height
          .ListFillRange = ws2.Range(Str).Address(external:=True)
          .LinkedCell = Target.Address
        End With

        ComBody.Activate

        'Open the dropdown list automatically
        Me.ComboShtBody.DropDown
    End If
End If

ExitHandler:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
        Exit Sub

ErrHandler:
    Resume ExitHandler

End Sub

第二个代码，放在ThisWorkbook模块中，目前无效：

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

Dim wb1 As Workbook
Dim ws1 As Worksheet, ws As Worksheet

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

Set wb1 = ThisWorkbook
Set ws1 = Sh

On Error GoTo LetsContinue
'This should change "D4" value on all sheets, but does not work after combobox feature was added to the sheets.
If Not Intersect(Target, ws1.Range("D4")) Is Nothing Then
    MsgBox Target.Address 'returns nothing
    For Each ws In wb1.Worksheets
        If Target.Value <> ws.Range(Target.Address).Value Then
            ws.Range(Target.Address).Value = Target.Value
        End If
    Next ws
Else
    GoTo LetsContinue
End If

LetsContinue:
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

End Sub

Answer 1

实际上，当我从Excel 2007迁移到2013版本时，第二个看待屏幕闪烁的问题就解决了。这似乎是旧版本中的某种错误。

单元格中的数据验证和组合框 - Workbook_SheetChange事件无效

1 个答案: