VBA向WorkSheet模块写入代码时如何保留已有对象实例?
问题描述
我使用WorkBook_NewSheet事件新增工作表,事件代码如下:
Private Sub thisWbk_NewSheet(ByVal Sh As Object) Application.ScreenUpdating = False Application.DisplayAlerts = False If SkipWBEvent = True Then Exit Sub If TypeOf Sh Is Worksheet Then Set oWks = Sh End If Dim objEvents As EventsObject Dim WBEvents As EventsWB RaiseEvent objSender.GetEvents(objEvents) Set WBEvents = objEvents.WBEvents RaiseEvent WBEvents.WBNewSheet(oWks) Application.ScreenUpdating = True With New WSModuleCode .LoadModuleCode oWks End With End Sub
代码按预期运行成功新增工作表,流程同时会执行格式设置、列宽调整操作。调用LoadModuleCode时,会向工作表模块写入用于触发SelectionChange事件的所需代码。
Public Sub LoadModuleCode(ByRef Wks As Worksheet) Dim VBComp As VBIDE.VBComponent Dim SheetMod As CodeModule With ActiveWbk.VBProject Set VBComp = .VBComponents(Wks.CodeName) End With Set SheetMod = VBComp.CodeModule With SheetMod If .CountOfDeclarationLines <= 2 Then SheetCode SheetMod, Wks End If End With End Sub Private Sub SheetCode(ByRef SheetMod As CodeModule, ByRef Wks As Worksheet) Dim ProcString As String Dim l As Long Dim EnumSheet As SheetEnum Const A As String = "SheetModuleCode" On Error GoTo EH TryAgain: EnumSheet = SourceTyper.SheetType(Wks) Const SChArgs As String = "(ByVal Target As Range)" Const ConName = "WorkSheet" Select Case EnumSheet Case MainSheet, VSELSheet ProcString = "Private Sub " & ConName & "_SelectionChange" & SChArgs Case Else 'For expansion? End Select With SheetMod l = .CountOfLines .InsertLines l + 1, ProcString .InsertLines l + 2, "" .InsertLines l + 3, "Dim oWks As Worksheet" .InsertLines l + 4, "Dim objController As Controller" .InsertLines l + 5, "" .InsertLines l + 6, "If SkipWSEvent = True Then Exit Sub" .InsertLines l + 7, "" .InsertLines l + 8, "Set oWks = Target.Parent" .InsertLines l + 9, "Set objController = TheController" .InsertLines l + 10, "" .InsertLines l + 11, "If Not objController.ActiveParent Is oWks Then" .InsertLines l + 12, "objController.InitializeSources oWks" .InsertLines l + 13, "End If" .InsertLines l + 14, "" .InsertLines l + 15, "SkipControlEvent = False" .InsertLines l + 16, "SkipWSEvent = False" .InsertLines l + 17, "Application.EnableEvents = True" .InsertLines l + 18, "" .InsertLines l + 19, "End Sub" End With Exit Sub EH: MsgBox Application.VBE.ActiveCodePane.CodeModule.Name & " " & A MsgBox "Error Line: " & Erl & vbCrLf & vbCrLf & _ "Error: (" & Err.Number & ") " & Err.Description, vbCritical Application.Wait Now + TimeValue("00:00:01") GoTo TryAgain End Sub
上述代码运行后,WorkSheet_SelectionChange事件的声明和代码会成功写入工作表模块,但此时所有代码执行会终止,项目内所有阶段创建的对象实例全部被销毁,导致列宽调整和最终格式设置操作中断,即使该问题代码是在流程末尾执行的。
由于工作表是动态新增的,无法预先在新增的工作表模块中硬编码所需代码。此前考虑的临时方案是在下一次工作表选择事件触发时再运行LoadModuleCode:此时依然会销毁所有对象,但代码写入完成后,事件可以重新创建所有对象,不过这意味着需要额外点击一次工作表才能恢复正常功能。想要实现编译器重新编译模块代码时保留已有的对象实例。
最终解决方案
适配当前场景的可行方案如下:将新增WSModuleCode的With代码块从Workbook_NewSheet事件中移出,放到触发新增工作表操作的按钮点击事件末尾执行。这样新增工作表后代码会被写入工作表模块,虽然对象还是会被销毁,但后续触发该工作表的Worksheet_SelectionChange事件时就可以重新创建对象,不影响正常使用。
内容的提问来源于stack exchange,提问作者LudieJ
相关产品推荐
相关产品推荐

