VBA连续调用模块触发Error 438（对象不支持该属性或方法）如何解决？

错误根因 #

• 核心触发原因是重复创建同名OLE控件：手动分步执行时，通常每次执行前都会删除上一次创建的Label1控件，因此不会冲突；但连续调用时如果工作表中已存在名为Label1的OLE对象，再次调用OLEObjects.Add创建同名控件就会抛出438错误。
• 次要不稳定因素：刚创建的OLE控件未完成接口注册时，直接用Worksheets("Main").Label1这种隐式方式访问控件属性，也可能触发属性不识别的438错误。

解决方案 #

1. 修改模块1的StatusCreator过程，增加已有控件校验删除逻辑 #

修改后代码如下：

Sub StatusCreator()
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic

    Dim ctop#, cleft#, cht#, cwdth#
    Dim sht    As Worksheet
    Dim Btn    As OLEObject
    Dim oleObj As OLEObject
    Set sht = ThisWorkbook.Worksheets("Main")
    
    ' 新增：删除已存在的同名Label控件，避免重复创建冲突
    For Each oleObj In sht.OLEObjects
        If oleObj.Name = "Label1" Then
            oleObj.Delete
            Exit For
        End If
    Next
    
    With sht.Range("H15:L37")
        ctop = .Top
        cleft = .Left
        cht = .Height
        cwdth = .Width
    End With
    With sht
        Set Btn = .OLEObjects.Add(classtype:="Forms.Label.1", Left:=cleft, Top:=ctop, Width:=cwdth, Height:=cht)
    End With
    DoEvents

    With Btn
        .Name = "Label1"
        .Object.Caption = "Starting...."
        .Object.Font.Size = 24
        .Object.Font.Bold = False
        .Object.BackColor = RGB(0, 244, 0)
    End With
    DoEvents
    Application.Wait (Now + TimeValue("0:00:01"))
End Sub

2. 修改模块2的StatusLabel1过程，改用显式方式访问OLE控件属性 #

修改后代码如下：

Sub StatusLabel1()
    Application.EnableEvents = True
    Application.ScreenUpdating = True

    ' 改用OLEObjects集合显式访问控件，避免接口未注册导致的属性识别失败
    ThisWorkbook.Worksheets("Main").OLEObjects("Label1").Object.Caption = _
    "                          Status" & vbNewLine & _
    "    DefinePaths....................Running" & vbNewLine & _
    "    CreateFolders.................Waiting" & vbNewLine & _
    "    CloseWorkbooks.............Waiting" & vbNewLine & _
    "    Shippments to xy........Waiting" & vbNewLine & _
    "    Scrap Report....................Waiting" & vbNewLine & _
    "    Shippment to xz...Waiting" & vbNewLine & _
    "    Shippments to zz........Waiting" & vbNewLine & _
    "    Database Update.............Waiting" & vbNewLine & _
    "    Database Backup.............Waiting" & vbNewLine & _
    "    Clear temporary files.......Waiting" & vbNewLine & _
    "    Start next schedule..........Waiting"
    DoEvents
    Application.Wait (Now + TimeValue("0:00:01"))
    Application.EnableEvents = False
    Application.ScreenUpdating = False
End Sub

修改完成后再连续调用两个过程即可正常运行，不会再触发438错误。

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