Worksheet_Change宏中调用Workbooks.Open失效问题求助

核心问题 #

当Worksheet_Change事件触发时，调用Workbooks.Open无法打开指定工作簿；将打开代码移至独立宏后，工作表调用该宏虽能触发（弹窗验证）但仍无法打开，直接运行模块宏则正常；同时工作表宏调用UserForm1时，窗体中的Workbooks.Open失效，直接运行窗体则正常。

关键原因 #

1. 事件重入干扰：Worksheet_Change触发过程中，打开工作簿的操作可能再次触发工作表事件，打断原执行流程。
2. 上下文焦点/界面阻塞：事件触发时Excel焦点锁定在当前工作表，工作簿打开后未获得焦点导致界面无响应；模态用户窗体独占焦点，阻塞工作簿打开动作。
3. 路径不一致：工作表宏与用户窗体中使用的文件路径用户名不同（Me vs GDNMNL78P06G843E），导致窗体中无法定位目标文件。

修复代码示例 #

修正后的工作表宏代码 #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x As Integer
    Dim C As Integer, r As Integer
    Dim wb As Workbook
    
    ' 禁用事件防止重入
    Application.EnableEvents = False
    
    x = 5
    If Not Intersect(Target, Range("S5:S500")) Is Nothing Then
        C = Target.Column
        r = Target.Row
        If Cells(r, C) = "SI" Then
            ' 打开工作簿并强制激活，确保界面刷新
            Set wb = Workbooks.Open("C:\Users\Me\Documents\RATEAZIONEPROVA.xlsm")
            wb.Activate
            DoEvents
            ' 改为非模态显示窗体，避免阻塞
            UserForm1.Show vbModeless
            ' rest of code
        End If
    End If
    
    ' 恢复事件触发
    Application.EnableEvents = True
End Sub

修正后的用户窗体代码 #

Private Sub CommandButton1_Click()
    Dim i As Integer
    Dim wb As Workbook
    
    For i = 1 To 3
        If Me.Controls("COMBOBOX" & i) = "" Then
            MsgBox "COMPILARE TUTTI I CAMPI PER PROSEGUIRE", vbExclamation, "ERRORE"
            Exit Sub
        End If
    Next
    For i = 1 To 4
        If Me.Controls("TEXTBOX" & i) = "" Then
            MsgBox "COMPILARE TUTTI I CAMPI PER PROSEGUIRE", vbExclamation, "ERRORE"
            Exit Sub
        End If
    Next
    
    ' 统一文件路径，确保与工作表宏一致
    Set wb = Workbooks.Open("C:\Users\Me\Documents\RATEAZIONEPROVA.xlsm")
    wb.Activate
    DoEvents
    ' rest of the code
End Sub

额外排查建议 #

• 确认目标工作簿未被其他程序占用，且文件权限正常。
• 若仍存在问题，可尝试在打开代码前添加Application.ScreenUpdating = True强制刷新界面。

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