vba - 单元格中的数据验证和组合框 - Workbook_SheetChange 事件不起作用

Question

我已经从 Contextures 网站改编了以下代码，该代码将组合框功能添加到包含数据验证的单元格中。尽管组合框可以很好地显示在应有的位置，但我仍然面临两个问题。
首先，我需要在结合数据验证和组合框的“D4”单元格中选择值后，在工作簿的“D4”单元格的其他工作表上显示相同的值。不幸的是，在添加组合框代码后，Workbook_SheetChange 代码停止工作。我认为这是因为它现在无法在数据验证/组合框单元格中找到目标。
第二个问题是即使应用了 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 版本时，关于屏幕闪烁的第二个问题自行解决了。这似乎是旧版本中的某种错误。