VBA修改工作表CodeName偶发报错问题求助

这种偶发的Method 'Value' of object 'Property' failed错误，本质是VBA编辑器(VBE)在处理工作表创建/删除时的对象同步延迟导致的——当你刚删除旧工作表、又立即修改新工作表的CodeName时，VBE的VBComponent对象可能还处于未完全刷新的状态，偶数次运行时冲突更明显，是因为前一次操作的对象引用残留未被释放。

以下是两种经过验证的解决方法：

方案1：调整操作顺序+重试机制 #

先删除旧工作表，再创建新表，避免新旧工作表的VBComponent在VBE中冲突；同时添加延迟和重试逻辑，给VBE足够时间同步对象：

' 需在模块顶部添加API声明（64位Excel用PtrSafe版本）
#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Function AddWorksheet(CodeNameOfWorksheet As String, NameOfWorksheet As String) As Worksheet
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet
    Dim wsNew As Worksheet
    
    Application.DisplayAlerts = False        
    ' 先删除目标CodeName的旧工作表，避免集合枚举错误，删除后直接跳出循环
    For Each ws In wb.Worksheets
        If ws.CodeName = CodeNameOfWorksheet Then
            ws.Delete
            Exit For
        End If
    Next ws
    
    Set wsNew = wb.Worksheets.Add
    DoEvents ' 让VBE同步新工作表的VBComponent
    
    ' 最多重试3次修改CodeName
    Dim retryCount As Integer
    retryCount = 0
Retry:
    On Error Resume Next
    wb.VBProject.VBComponents(wsNew.CodeName).Properties("_CodeName").Value = CodeNameOfWorksheet
    On Error GoTo 0
    
    ' 验证修改是否成功，失败则重试
    If wb.VBProject.VBComponents(wsNew.CodeName).Properties("_CodeName").Value <> CodeNameOfWorksheet Then
        retryCount = retryCount + 1
        If retryCount <= 3 Then
            DoEvents
            Sleep 100 ' 等待100毫秒让VBE刷新
            GoTo Retry
        Else
            Err.Raise vbObjectError + 1001, , "无法设置工作表CodeName"
        End If
    End If
    
    wsNew.Name = NameOfWorksheet
    Application.DisplayAlerts = True
    Set AddWorksheet = wsNew
End Function

方案2：通过工作表索引定位VBComponent（更稳定） #

避免依赖新工作表的初始CodeName，直接用工作表的Index定位对应的VBComponent，减少引用冲突：

' 需在模块顶部添加API声明（同方案1）
#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#End If

Function AddWorksheet(CodeNameOfWorksheet As String, NameOfWorksheet As String) As Worksheet
    Dim wb As Workbook: Set wb = ThisWorkbook
    Dim ws As Worksheet
    Dim wsNew As Worksheet
    Dim vbComp As VBComponent
    
    Application.DisplayAlerts = False        
    ' 删除旧工作表
    For Each ws In wb.Worksheets
        If ws.CodeName = CodeNameOfWorksheet Then
            ws.Delete
            Exit For
        End If
    Next ws
    
    Set wsNew = wb.Worksheets.Add
    DoEvents
    
    ' 通过工作表索引直接获取对应的VBComponent，避免初始CodeName的引用问题
    Set vbComp = wb.VBProject.VBComponents(wsNew.Index)
    
    ' 重试修改CodeName
    Dim retryCount As Integer
    retryCount = 0
Retry:
    On Error Resume Next
    vbComp.Properties("_CodeName").Value = CodeNameOfWorksheet
    On Error GoTo 0
    
    If vbComp.Properties("_CodeName").Value <> CodeNameOfWorksheet Then
        retryCount = retryCount + 1
        If retryCount <= 3 Then
            DoEvents
            Sleep 100
            GoTo Retry
        Else
            Err.Raise vbObjectError + 1001, , "无法设置工作表CodeName"
        End If
    End If
    
    wsNew.Name = NameOfWorksheet
    Application.DisplayAlerts = True
    Set AddWorksheet = wsNew
End Function

关键注意事项 #

• 确保Excel信任中心已启用信任对VBA项目对象模型的访问（路径：文件>选项>信任中心>信任中心设置>宏设置），这是修改CodeName的必要前提。
• 不要在循环中持续修改工作表集合（比如删除后继续遍历），会触发集合枚举错误，删除目标工作表后直接用Exit For跳出循环。

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