修改Excel ThisWorkbook模块后关闭工作簿时VBA代码终止问题求助

我需要动态修改Excel文件，添加模块并通过.CodeModule.AddFromString修改"ThisWorkbook"模块，但修改后保存关闭工作簿时VBA代码会终止。查了很多资料都是这么操作的，但没人提关闭时的错误。试过换成.CodeModule.AddFromFile，问题依旧；但注释掉修改ThisWorkbook模块的代码，只添加其他模块时，代码能正常执行无错误。

主代码（CargaCodigo.xlsm中的代码） #

Option Explicit

Dim LibroDestino As Workbook
Dim strArchivo As String, Hojadestino As String
Dim strNuevoArchivo As String
Dim strPathNuevoArchivo As String
Dim strRutaI As String, strRutaO As String, strCodigoCopiar As String, strTextLine As String
Dim i As Integer, lineas As Integer
Dim dFxMartes As Date
Dim Dialogo As FileDialog
Dim variable As String

Private Sub Workbook_Open()
    Dim Libro As Workbook

    ' Application.Visible = False
    
    If ThisWorkbook.Name = "CargaCodigo.xlsm" Then
    
        On Error GoTo gestErr
        
        strRutaI = "\\empresa.net\COMISIÓN\code\"
        strRutaO = "\\empresa.net\COMISIÓN\"
        
        Set Dialogo = Application.FileDialog(msoFileDialogFilePicker)
        
        With Dialogo
            .Filters.Clear
            .Filters.Add "Excel (*.xlsx, *.xls)", "*.xlsx, *.xls"
            .InitialFileName = strRutaO
            .AllowMultiSelect = False
        End With
        
        If Dialogo.Show = -1 Then
        
            strArchivo = Dialogo.SelectedItems(1)
            
        Else
            ThisWorkbook.Close savechanges:=False
            Exit Sub
        End If
        
        Set Dialogo = Nothing
    
        If Right(strArchivo, 4) = ".xls" Or _
            Right(strArchivo, 5) = ".xlsx" Then
            
            Set LibroDestino = Workbooks.Open(strArchivo)
            
            For i = 0 To 6
                dFxMartes = Date + i
                'If DatePart("w", dFxMartes, vbUseSystem) = vbTuesday Then
                If DatePart("w", dFxMartes) = vbTuesday Then
                    Exit For
                End If
            Next i
            
            strNuevoArchivo = "REUNION OD " & Format(Year(dFxMartes), "00") & Format(Month(dFxMartes), "00") & Format(Day(dFxMartes), "00") & ".xlsm"
            
            Set Dialogo = Application.FileDialog(msoFileDialogSaveAs)
        
            With Dialogo
                .FilterIndex = 2                            ' .xlsm extension
                .InitialFileName = strRutaO & strNuevoArchivo
            End With
            
            If Dialogo.Show = -1 Then 
                strPathNuevoArchivo = Dialogo.SelectedItems(1)
                strNuevoArchivo = Right(strPathNuevoArchivo, Len(strPathNuevoArchivo) - InStrRev(strPathNuevoArchivo, "\"))
                
                Hojadestino = "ThisWorkbook"
                
                strCodigoCopiar = ""
                Open strRutaI & "ThisWorkbook.bas" For Input As #1 
                Do While Not EOF(1)                             
                    Line Input #1, strTextLine                   
                    strCodigoCopiar = strCodigoCopiar & strTextLine & vbCrLf     
                Loop
                Close #1                                        

                LibroDestino.VBProject.VBComponents(Hojadestino).CodeModule.AddFromString strCodigoCopiar

                LibroDestino.VBProject.VBComponents.Import strRutaI & "frmOD.bas"
                
                strCodigoCopiar = ""
                
                LibroDestino.SaveAs Filename:=strNuevoArchivo, FileFormat:=XlFileFormat.xlOpenXMLWorkbookMacroEnabled
                
                Kill strArchivo
                
                On Error Resume Next
    
                LibroDestino.Close
                    
                If Err.Number <> 0 Then
                    MsgBox "Error: " & Err.Number & " - " & Err.Description
                End If
                
                MsgBox "Correcto.", vbInformation + vbOKOnly
            Else 
                
                LibroDestino.Close savechanges:=False
                ThisWorkbook.Close savechanges:=False
                
            End If
            
            On Error GoTo 0 
            
            Set Dialogo = Nothing
        End If
    End If
    
    ThisWorkbook.Close savechanges:=False
    
Exit Sub

gestErr:
    MsgBox "Error: " & Err.Number & " - " & Err.Description, vbCritical + vbOKOnly, "Error"
    
    Resume Next
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

    On Error GoTo gestErr
    
    If ThisWorkbook.Name = "CargaCodigo.xlsm" Then
        Application.Visible = True
                
        End
    End If

Exit Sub
gestErr:
    MsgBox "Error: " & Err.Number & " - " & Err.Description, vbCritical + vbOKOnly, "Error"
    
    Resume Next
End Sub

ThisWorkbook.bas文件内容 #

Dim i As Integer

Private Sub Workbook_Open()

    Application.Visible = False                     ' Oculta el libro excel.
    'Application.ScreenUpdating = False              ' Desactiva la actualización de las hojas.
    'Application.Calculation = xlCalculationManual   ' Desactiva el cálculo automático de las celdas.
    
    If Left(ActiveWorkbook.Name, 11) = "REUNION OD " And _
      Right(ActiveWorkbook.Name, 5) = ".xlsm" Then
        frmOD.Show
    End If

    ThisWorkbook.Close (False)
    
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
    Application.Visible = True
    
    End
    
    Application.Quit

End Sub

问题原因与解决办法 #

核心原因 #

问题出在你写入ThisWorkbook模块的Workbook_BeforeClose事件代码中：

• 代码里的End语句会立即强制终止所有正在运行的VBA代码，包括主程序中关闭LibroDestino的后续流程。当你关闭修改后的工作簿时，这个事件被触发，End直接打断了主代码的执行，导致出现“代码终止”的现象。

修复方案 #

1. 修改ThisWorkbook.bas中的Workbook_BeforeClose事件，移除End语句：

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    
    Application.Visible = True
    ' 移除End语句，避免强制终止所有代码
    ' End
    
    Application.Quit

End Sub

2. 可选优化：主代码中关闭工作簿前，暂时禁用事件，避免新添加的事件干扰当前执行流程：

' 替换原有的LibroDestino.Close代码段
On Error Resume Next
Application.EnableEvents = False ' 禁用事件触发
LibroDestino.Close
Application.EnableEvents = True ' 恢复事件

3. 可选优化：写入ThisWorkbook代码前清空原有内容，避免重复添加事件导致冲突：

' 替换原有的AddFromString代码段
With LibroDestino.VBProject.VBComponents(Hojadestino).CodeModule
    .DeleteLines 1, .CountOfLines ' 清空原有代码
    .AddFromString strCodigoCopiar
End With

内容的提问来源于stack exchange，提问作者Carlos Torres