Excel VBA设置形状格式时触发424对象错误的原因

你的代码触发424对象错误主要有以下几个核心问题：

1. Shape对象赋值错误

   • 在Datum = 2023分支中，仅执行了形状创建并选中，但未将创建的形状对象赋值给shp变量，此时shp为Nothing，调用其属性自然触发对象错误。
   • 在Datum = 2024分支中，试图将.Select的返回值赋值给shp，但.Select返回的是布尔值（表示选中是否成功），而非Shape对象，导致shp无法指向有效形状。

2. 过程命名违反VBA规则
   VBA的过程（Sub）名称不能以数字开头，Sub 1()属于非法命名，必须修改为合法名称（如Sub AddYearShape()）。

3. 字符串与数值的比较逻辑失效
   Datum是String类型，InputBox返回的也是字符串，但直接与数值2023/2024比较，会导致判断不成立（字符串"2023"和数值2023在VBA中不相等）。

4. 缺少End If闭合语句
   If...ElseIf结构未用End If闭合，会引发编译错误。

修正后的代码 #

Sub AddYearShape()
    Dim clLeft As Double
    Dim clTop As Double
    Dim Datum As String
    Dim cl As Range
    Dim shp As Shape
    
    Datum = InputBox("Welches Jahr")
    
    If Datum = "2023" Then
        Set cl = Range("F7")
        
        clLeft = cl.Left
        clTop = cl.Top
        
        ' 直接将创建的形状赋值给shp，无需Select
        Set shp = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, clLeft, clTop, Range("K36").Value * 80, 37)
        shp.TextFrame2.TextRange.Text = "Test"
        shp.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(225, 140, 71)
        shp.TextFrame2.TextRange.Font.Size = 14
        
    ElseIf Datum = "2024" Then
        Set cl = Range("R7")
        
        clLeft = cl.Left
        clTop = cl.Top
        
        ' 直接赋值Shape对象，去掉无用的.Select
        Set shp = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, clLeft, clTop, Range("K36").Value * 80, 37)
        shp.TextFrame2.TextRange.Text = "Test"
        shp.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(225, 140, 71)
        shp.TextFrame2.TextRange.Font.Size = 14
        
    End If ' 补充闭合If结构
End Sub

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