You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

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

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.10.08 15:00:04