已分配 Excel VBA 工作表更改事件

Question

使用 Excel 2007，我知道我可以在它创建的工作表上创建 worksheet_change 事件。

但是如何将全局子更改事件分配给新创建的工作表？

例如

Public Sub DataChange(ByVal Target As Range)
  ' this will check and see if the user or operator has change the column field
  ' if they fill in "X", mark the whole row to red color
  ' otherwise leave it black
  Dim KeyCells As Range
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, 1).END(xlUp).Row
  Set KeyCells = Range("L2:L" & LastRow)

  If Not Application.Intersect(KeyCells, Range(Target.Address)) _
    Is Nothing Then
    If Target.Value = "X" Or Target.Value = "x" Then
        Target.EntireRow.Font.color = vbRed
    Else
        Target.EntireRow.Font.color = vbBlack
    End If
  End If
End Sub

然后在Module1中的一个单独的子过程中...

Public Sub CreateWorkSheet() 
  Dim ws As Worksheet

  Set ws = Sheets.Add
  ws.Name = "Test1"
  ' Here where I want to set the event but I do not know the syntax
  ' ws.OnChange = DataChange

  Debug.Print "Done"

End Sub 

我习惯于在创建控件 (C#/WPF/Pascal) 时动态分配事件，所以我认为 Excel 世界中会有一个。任何建议或帮助将不胜感激。

Answer 1

正如 Jeeped 所提到的，可能最简单的方法是复制后面已经有 Private Sub Worksheet_Change 代码的工作表，但还有另一种方法，如果您将以下代码放在 ThisWorkbook 下，每当一个新的工作表被创建，它将在其后面添加所需的代码：

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Dim NewSheet As Worksheet
    Set NewSheet = Sheets(ActiveSheet.Name)
    Code = "Private Sub Worksheet_Change(ByVal Target As Range)" & vbCrLf
    Code = Code & "MsgBox ""your code here""" & vbCrLf
    Code = Code & "End Sub"
    With ThisWorkbook.VBProject.VBComponents(NewSheet.Name).CodeModule
    NextLine = .CountOfLines + 1
    .InsertLines NextLine, Code
    End With
End Sub

这里的缺点是需要通过单击 Trust access to the VBA project object model 来更改宏的信任设置：

编辑：

您也可以使用类似的方法将代码从一个工作表复制到另一个工作表：

Sub test()
Dim CodeCopy As VBIDE.CodeModule
Dim CodePaste As VBIDE.CodeModule
Dim numLines As Long

Set CodeCopy = ActiveWorkbook.VBProject.VBComponents("Sheet1").CodeModule
Set CodePaste = ActiveWorkbook.VBProject.VBComponents("Sheet2").CodeModule

numLines = CodeCopy.CountOfLines
'Use this line to erase all code that might already be in sheet2
'If CodePaste.CountOfLines > 1 Then CodePaste.DeleteLines 1, CodePaste.CountOfLines

CodePaste.AddFromString CodeCopy.Lines(1, numLines)
End Sub

Answer 2

我会接受@Jeeped 的最后一个建议

将此代码放在ThisWorkbook 代码窗格中

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    DataChange Target ' this sub will be called at any change of any worksheet passing the chenged range
End Sub

然后将其放在同一代码窗格或任何其他模块中

Public Sub DataChange(ByVal Target As Range)
  ' this will check and see if the user or operator has change the column field
  ' if they fill in "X", mark the whole row to red color
  ' otherwise leave it black
  Dim KeyCells As Range
  Set KeyCells = Range("L2:L" & Cells(Rows.Count, 1).End(xlUp).Row)

  If Not Application.Intersect(KeyCells, Target) Is Nothing Then Target.EntireRow.Font.color = IIf(UCase(Target.Value2) = "X", vbRed, vbBlack)
End Sub