Excel VBA向动态新增工作表添加形状报运行时错误438如何解决

错误原因 #

你遇到的报错核心是变量类型混用：

• 你最开始把BN定义为Range（单元格对象），用来存储你选中的、填写了工作表名称的单元格
• 后续你想调用新建工作表的Shapes方法时，直接写了BN.Shapes，但此时BN还是单元格对象，单元格本身没有Shapes属性，所以就触发了“对象不支持该属性或方法”的报错。
  你之前用已存在的工作表Tool运行正常，是因为Tool本身就是工作表的代码名，属于合法的工作表对象。

修复方案 #

只需要新增一个专门存储新建工作表的变量，操作新表时用这个变量即可，修改后的完整代码如下（改动点都加了注释）：

Sub Prepare_Bowtie()
    Tool.Select
    Cells(1, 1).Select
    '选择填写了工作表名称的单元格
    Dim BN As Range
    Set BN = Application.InputBox("Select Cell with Bowtie Number", "Bowtie preparation - Bowtie Number", Type:=8)
    
    ' 新增变量：专门存储新建的工作表
    Dim newWS As Worksheet
    
    If BN = vbNullString Then
        MsgBox "No Cell Selected"
        Exit Sub ' 未选中单元格直接退出程序，不会运行后续无效代码
    Else
        Sheets.Add After:=Sheets(Sheets.Count)
        ' 把新建的工作表赋值给newWS变量，后续所有新表操作都用这个变量
        Set newWS = ActiveSheet
        newWS.Name = BN.Value ' 明确取单元格内容作为工作表名称
        With newWS
            .Parent.VBProject.VBComponents(.CodeName).Properties("_CodeName") = BN.Value
        End With
        Tool.Select
    End If
    
    Dim ThreatRng As Range ' 重命名存储威胁内容的变量，避免和循环变量重名冲突
    Set ThreatRng = Application.InputBox("Select all cells with threats", "Bowtie preparation - Threat Selection", , , , , , 8)
    
    Dim a As Long
    Dim S As Shape
    a = 20
    Dim Threat As Range
    For Each Threat In ThreatRng ' 遍历所有选中的威胁单元格
        ' 用新表变量调用AddShape方法，不会再报错
        Set S = newWS.Shapes.AddShape(msoShapeRectangle, 20, a, 200, 100)
        S.Fill.ForeColor.RGB = RGB(0, 0, 0)
        S.TextFrame.Characters.Text = Threat.Value
        
        With S.TextFrame.Characters.Font
            .Color = RGB(255, 255, 255)
            .Size = 15
            .Name = "Calibri"
        End With
        
        With S.TextFrame
            .Orientation = msoTextOrientationHorizontal
            .HorizontalAlignment = xlHAlignCenter
            .VerticalAlignment = xlVAlignCenter
        End With
        a = a + 150
    Next Threat
    
    ' 原代码最后两行会直接删掉你刚建好的工作表，如果不是特意要删，直接注释或删除这三行即可
    ' On Error Resume Next
    ' Sheets(BN).Delete
    ' On Error GoTo 0
End Sub

额外注意：如果运行时提示“无法访问VB项目”，你需要打开Excel信任中心，在宏设置里勾选「信任对VBA工程对象模型的访问」，就能正常修改工作表代码名了。

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