如何通过VBA将Excel命名范围的作用域设置为工作簿级

问题分析 #

你的代码在创建工作簿级命名范围时存在两个核心问题：

1. 命名名称提取错误：工作表级命名的Name属性格式为工作表名!命名名，硬编码用Mid(rname.Name, 6, 100)提取名称会因工作表名长度变化失效。
2. 工作簿级命名规则错误：不需要在名称前附加工作簿名，直接使用纯命名名称即可创建工作簿级作用域的命名。

修正后的完整代码 #

Sub UpdateSheetsAndNames()
    Dim rname As Name
    Dim ws As Worksheet
    Dim rangeName As String
    
    ' 1. 删除旧的工作簿级命名和原Base工作表的命名
    For Each rname In ActiveWorkbook.Names
        If rname.Visible Then
            ' 工作簿级命名的Parent是工作簿对象，工作表级命名Parent是对应工作表
            If rname.Parent Is ActiveWorkbook Or rname.Parent.Name = "Base" Then
                rname.Delete
            End If
        End If
    Next rname
    
    ' 2. 删除指定外的工作表
    Application.DisplayAlerts = False ' 关闭删除提示
    For Each ws In ActiveWorkbook.Sheets
        Select Case ws.Name
            Case "BaseTemplate", "CraneTemplate", "LotInspection", "LS2", "InvestmentSummary", "TemplatePage"
                ' 保留这些工作表，不做操作
            Case Else
                ws.Delete
        End Select
    Next ws
    Application.DisplayAlerts = True ' 恢复提示
    
    ' 3. 复制模板并创建新工作表
    Sheets("CraneTemplate").Copy Before:=Sheets(1)
    ActiveSheet.Name = "Crane"
    
    Sheets("BaseTemplate").Copy Before:=Sheets(1)
    ActiveSheet.Name = "Base"
    
    ' 4. 将Base工作表的工作表级命名转为工作簿级
    For Each rname In Worksheets("Base").Names
        If rname.Visible Then
            ' 拆分出真实的命名名称（去掉工作表名前缀）
            rangeName = Split(rname.Name, "!")(1)
            ' 创建工作簿级命名
            ThisWorkbook.Names.Add _
                Name:=rangeName, _
                RefersTo:=rname.RefersTo, _
                Visible:=True
            ' 可选：删除原工作表级命名，避免重复
            rname.Delete
        End If
    Next rname
End Sub

关键修正点说明 #

• 命名名称提取：使用Split(rname.Name, "!")(1)准确拆分出工作表级命名的真实名称，兼容任意长度的工作表名。
• 工作簿级命名创建：直接通过ThisWorkbook.Names.Add创建，Name参数使用纯命名名称，自动生成工作簿级作用域。
• 优化删除逻辑：用Select Case替代冗长的And判断，同时关闭删除提示提升操作体验。
• 作用域判断优化：通过rname.Parent Is ActiveWorkbook准确识别工作簿级命名，避免因工作簿名称字符串匹配出错。

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