在错误处理子程序中调整条件格式触发Excel 1004错误求助

从你的代码场景来看，核心问题出在Workbook_SheetChange的错误分支里调用Initialize时，Excel处于粘贴操作失败后的不稳定上下文状态，导致格式条件相关操作触发1004权限/对象操作错误。而工作簿打开时调用Initialize是在干净的启动上下文里，所以不会出现问题。以下是具体的分析和修复方案：

问题根源拆解 #

当用户尝试粘贴不匹配的合并单元格时，Excel的剪贴板资源、Range对象状态都处于未完全重置的异常状态，此时直接调用Initialize操作格式条件，会因为内部状态冲突（比如部分Range锁定、剪贴板未释放）导致操作失败。

针对性修复方案 #

1. 优化错误处理的上下文清理 #

在调用Initialize之前，先彻底清理错误状态，确保Excel回到稳定的操作环境：

• 释放剪贴板资源
• 重置事件状态
• 临时取消工作表保护（即使设置了UserInterfaceOnly:=True，错误上下文里仍可能存在权限冲突）

2. 给Initialize子程序添加局部错误防护 #

对格式条件的操作添加局部错误捕获，避免单一步骤的错误导致整个初始化崩溃，同时简化模块内公共变量的引用（无需加Module1.前缀）。

3. 提前拦截非法粘贴操作 #

在粘贴检查环节，提前判断粘贴内容与目标范围的匹配性，减少触发原生Excel错误的概率。

调整后的完整代码 #

修改后的错误处理代码 #

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    'Error Handling when workbook is unprotected so it doesn't lose it's protection on an error.
    On Error GoTo eh
    Dim lastAction As String
    Dim dataObj As DataObject
    
    '提前检查剪贴板内容，减少非法粘贴触发的错误
    Set dataObj = New DataObject
    dataObj.GetFromClipboard
    
    '获取用户最后操作（先判断Undo列表是否有内容，避免空引用错误）
    If Application.CommandBars("Standard").Controls("&Undo").ListCount > 0 Then
        lastAction = Application.CommandBars("Standard").Controls("&Undo").List(1)
        '检查是否为粘贴操作
        If Left(lastAction, 5) = "Paste" Then
            Application.EnableEvents = False
            Application.Undo
            '尝试粘贴值，提前处理范围不匹配问题
            On Error Resume Next
            Target.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone
            If Err.Number <> 0 Then
                MsgBox "粘贴范围不匹配，请调整后重试！", vbExclamation
            End If
            On Error GoTo eh
            Application.EnableEvents = True
        End If
    End If
    Exit Sub
eh:
    '彻底清理错误上下文
    Application.CutCopyMode = False '释放剪贴板资源
    Application.EnableEvents = True
    
    '临时取消保护，确保Initialize能正常操作
    ThisWorkbook.Sheets("Field Service Report").Unprotect Password:="x"
    
    '调用Initialize时添加局部错误捕获
    On Error Resume Next
    Call Initialize
    If Err.Number <> 0 Then
        MsgBox "初始化过程中出现错误：" & Err.Description, vbCritical
    End If
    On Error GoTo 0
    
    '恢复工作表保护
    ThisWorkbook.Sheets("Field Service Report").Protect Password:="x", UserInterfaceOnly:=True
End Sub

修改后的Initialize子程序 #

Option Explicit
Public Fixed As Range
Public Motor As Range
Public Engine As Range
Public Stage1 As Range
Public Stage2 As Range
Public Stage3 As Range
Public Drive As Range
Public Stage As Range
Public Required As Range
Public SaveChk As Integer
Public SaveName As String
Public UserPath As String
Public Path As String
Public SaveError As Integer
Public EditChk As String
Public FormRange As Range

Sub Initialize()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Field Service Report")
    
    '设置所有检查和格式范围
    Set FormRange = ws.Range("A1:AL59")
    Set Fixed = ws.Range("I7,I8,Z7,E6,P6,X6,A45,A57,F57,L57,P57,V56,V57,X57,D28,D29,O28")
    Set Motor = ws.Range("AA28,AA29,Z30,AE30,AC31,AJ29,AK30,AK31")
    Set Engine = ws.Range("D15,M15,T15,AE15,AJ15,T17,AE17,AH17,J23,J24,J25,AA20,AA21,AA22,AA23,AA24,AA25,AJ20,AJ21,AJ22,AJ23,AJ24,AJ25")
    Set Stage1 = ws.Range("H37,N37,AA37,AG37,AG38,H38,K38,N38,Q38,AA38,AD38,AJ38")
    Set Stage2 = ws.Range("H39,N39,AA39,AG39,AG40,H40,K40,N40,Q40,AA39,AA40,AD40,AJ40")
    Set Stage3 = ws.Range("H41,N41,AA41,AG41,H42,N42,Q42,AA42,AG42,AJ42")
    
    '禁用未保护单元格的拖放功能
    Application.CellDragAndDrop = False
    
    '设置工作表初始参数
    EditChk = "N" '调试时设为Y允许未完成保存，常规使用设为N
    SaveChk = 0
    SaveError = 0
    
    '操作格式条件时添加局部错误捕获，避免单一步骤崩溃
    On Error Resume Next
    FormRange.FormatConditions.Delete
    If Err.Number <> 0 Then
        Debug.Print "清除格式条件错误：" & Err.Description
        Err.Clear
    End If
    
    With ws
        .Range("A1:AL59").ColumnWidth = 2
        .PageSetup.PrintArea = "A1:AL59"
    End With
    
    Sheet1.CheckBox26.Value = True
    Sheet1.CheckBox18.Value = False
    
    Motor.FormatConditions.Delete
    With Motor.FormatConditions.Add(Type:=xlBlanksCondition)
        .Interior.Color = vbRed
        .StopIfTrue = True
    End With
    
    Sheet1.Shapes("Option Button 134").ControlFormat.Value = xlOn
    
    Stage2.FormatConditions.Delete
    Stage3.FormatConditions.Delete
    
    Stage1.FormatConditions.Delete
    With Stage1.FormatConditions.Add(Type:=xlBlanksCondition)
        .Interior.Color = vbRed
        .StopIfTrue = True
    End With
    
    Set Stage = Stage1
    
    Fixed.FormatConditions.Delete
    With Fixed.FormatConditions.Add(Type:=xlBlanksCondition)
        .Interior.Color = vbRed
        .StopIfTrue = True
    End With
    On Error GoTo 0
End Sub

关键修复点说明 #

• 在错误处理分支里先执行Application.CutCopyMode = False释放剪贴板，避免资源占用导致的操作冲突
• 调用Initialize前临时取消工作表保护，确保格式条件操作拥有足够权限
• 在Initialize里对每一步格式条件操作添加局部错误捕获，防止单一步骤失败导致整个初始化崩溃
• 提前检查剪贴板和粘贴操作，减少触发原生Excel错误的概率，降低进入错误分支的频次

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