Vba 通过代码添加的Excel ActiveX标签具有奇怪的行为

我在构建包含ActiveX控件的工作表时遇到Excel崩溃问题。重建是痛苦的，即使考虑到它的发展频率，保存也相对频繁，因此我希望通过一个子控件来构建控件，我可以根据需要执行该子控件来重建图纸

下面的代码删除了所有现有的ActiveX控件，然后创建了五个标签。第一次在空白纸上执行就可以了。只是为了测试一下：

我再次执行，前四个标签位于正确的位置，但第五个标签不在那里，并且在我的工作表的右侧有一个“Label6”。 我执行了第三次，前三个标签和第五个标签在正确的位置，但第四个标签不在，并且在我的工作表的右侧有一个“Label6”。 我执行了第四次，前两个标签和后两个标签都在正确的位置，但第三个标签不在。在我的工作表的右侧有一个“Label6”。 我执行了第五次，第一个标签和最后三个标签都在正确的位置，但第二个标签不在，并且在我的工作表的右侧有一个“Label6”。 我执行了第六次，最后四个标签位于正确的位置，但第一个标签不在，并且在我的工作表的右侧有一个“Label6”。 我执行了第七次，它按预期工作 奇怪的是，如果我注释掉“Call CreateLabels”并分别执行CreateSearchScreen和CreateLabels子脚本，每次都可以正常工作

这似乎不是致命的，但我担心我有一些根本性的错误，当我需要它在现场工作时，我的错误会咬到我

任何关于如何追查我做错了什么的想法都将受到赞赏

Sub CreateSearchScreen()

    Dim oOBJECT As SHAPE

    'Delete all OLEObjects on the sheet
    For Each oOBJECT In Sheets("Search").Shapes
        If oOBJECT.Type = 12 Then oOBJECT.Delete
    Next oOBJECT

    Call CreateLabels

    ActiveSheet.Select

End Sub


Sub CreateLabels()

    Dim LABEL_CAPTIONS()
    Dim LOWER_BOUND As Long
    Dim UPPER_BOUND As Long
    Dim COUNTER As Long
    Dim oLABEL As OLEObject

    'Create Labels
    LABEL_CAPTIONS = Array("Posted", "Traded", "Offered", "Portfolio", "Transaction")

    For COUNTER = LBound(LABEL_CAPTIONS) To UBound(LABEL_CAPTIONS)

        Set oLABEL = Sheets("Search").OLEObjects.Add(classtype:="Forms.Label.1")

        With oLABEL

                .Object.BackColor = &H80000005
                .Object.ForeColor = &H80000008
                .Object.BorderStyle = 1
                .Top = 195
                .Height = 25
                .Width = 85
                .Object.Font.Size = 16
                .Object.BorderStyle = 1
                .Object.SpecialEffect = 0
                .Object.TextAlign = 2

                Select Case .Name

                    Case "Label1"
                            .Left = 20.25
                            .Object.Caption = LABEL_CAPTIONS(COUNTER)
                    Case "Label2"
                            .Left = 106.5
                            .Object.Caption = LABEL_CAPTIONS(COUNTER)
                    Case "Label3"
                            .Left = 192.75
                            .Object.Caption = LABEL_CAPTIONS(COUNTER)
                    Case "Label4"
                            .Left = 279
                            .Object.Caption = LABEL_CAPTIONS(COUNTER)
                    Case "Label5"
                            .Left = 365.25
                            .Object.Caption = LABEL_CAPTIONS(COUNTER)

                End Select

        End With

    Next COUNTER

End Sub

更新 此子CreateLabels的修订代码可运行2次迭代，然后我发现错误对象库无效或包含找不到的对象定义引用。这发生在子CreateSearch屏幕的第一行。如果我手动删除标签并重新开始，它会运行2次迭代，然后出现相同的问题

更新2 我修改了代码来创建标签，然后放置标签，但是在2次迭代之后同样的问题出现了。我没有使用函数，但我认为这不会影响事情。奇怪的是，我可以单独执行Sub，但不能从Sub CreateSearchScreen（现在调用CreateLabels2）执行

Sub CreateLabels2()

Dim LABEL_CAPTIONS()
Dim LOWER_BOUND As Long
Dim UPPER_BOUND As Long
Dim COUNTER As Long
Dim oLABEL As OLEObject

Set oLABEL = Nothing

'Create Labels
LABEL_CAPTIONS = Array("Posted", "Traded", "Offered", "Portfolio", "Transaction")

For COUNTER = LBound(LABEL_CAPTIONS) To UBound(LABEL_CAPTIONS)

        Set oLABEL = Sheets("Search").OLEObjects.Add(classtype:="Forms.Label.1")

        With oLABEL
                .Name = "Label" & COUNTER
                .Object.BackColor = &H80000005
                .Object.ForeColor = &H80000008
                .Object.BorderStyle = 1
                .Top = 195
                .Height = 25
                .Width = 85
                .Object.Font.Size = 16
                .Object.BorderStyle = 1
                .Object.SpecialEffect = 0
                .Object.TextAlign = 2
                .Object.Caption = LABEL_CAPTIONS(COUNTER)
        End With

Next COUNTER

Dim oOLEOBJ As OLEObject
For Each oOLEOBJ In Sheets("Search").OLEObjects

        With oOLEOBJ

                Select Case .Name

                    Case "Label1"
                            .Left = 20.25
                    Case "Label2"
                            .Left = 106.5
                    Case "Label3"
                            .Left = 192.75
                    Case "Label4"
                            .Left = 279
                    Case "Label5"
                            .Left = 365.25

                End Select

        End With

Next

---

End Sub

问题的产生是因为标签名称在创建时并不总是按顺序分配，并且名称似乎上升到label6，而在案例选择中没有处理

但是，您正在一个数组中循环，所以为什么不使用它来指定标签和位置

Sub CreateLabels()

    Dim LABEL_CAPTIONS()
    Dim LOWER_BOUND As Long
    Dim UPPER_BOUND As Long
    Dim COUNTER As Long
    Dim oLABEL As OLEObject
    Set oLABEL = Nothing

    'Create Labels
    LABEL_CAPTIONS = Array("Posted", "Traded", "Offered", "Portfolio", "Transaction")

    For COUNTER = LBound(LABEL_CAPTIONS) To UBound(LABEL_CAPTIONS)

        Set oLABEL = Sheets("Search").OLEObjects.Add(classtype:="Forms.Label.1")
        With oLABEL
            .Name = "Label" & COUNTER + 1
            .Object.Caption = LABEL_CAPTIONS(COUNTER)
            .Object.BackColor = &H80000005
            .Object.ForeColor = &H80000008
            .Object.BorderStyle = 1
            .Top = 195
            .Height = 25
            .Width = 85
            .Left = 20.25 + 86.25 * COUNTER
            .Object.Font.Size = 16
            .Object.BorderStyle = 1
            .Object.SpecialEffect = 0
            .Object.TextAlign = 2
        End With

    Next COUNTER

End Sub

更新： 我会先创建所有对象，然后再尝试进一步编辑它们

Function CreateLabels()

    Application.ScreenUpdating = False

    Dim LABEL_CAPTIONS()
    Dim COUNTER As Long
    Dim oLABEL As OLEObject
    Set oLABEL = Nothing

    'Create Labels
    LABEL_CAPTIONS = Array("Posted", "Traded", "Offered", "Portfolio", "Transaction")

    For COUNTER = LBound(LABEL_CAPTIONS) To UBound(LABEL_CAPTIONS)
        Set oLABEL = Sheets("Search").OLEObjects.Add(classtype:="Forms.Label.1")
        With oLABEL
            .Name = "Label" & COUNTER + 1
            .Object.Caption = LABEL_CAPTIONS(COUNTER)
            .Object.BackColor = &H80000005
            .Object.ForeColor = &H80000008
            .Object.BorderStyle = 1
            .Top = 195
            .Height = 25
            .Width = 85
            .Object.Font.Size = 16
            .Object.BorderStyle = 1
            .Object.SpecialEffect = 0
            .Object.TextAlign = 2
        End With
    Next COUNTER

    Dim OLEObj As OLEObject
    For Each OLEObj In Sheets("Search").OLEObjects
       Select Case OLEObj.Name
            Case "Label1"
                OLEObj.Left = 20.25
            Case "Label2"
                OLEObj.Left = 106.5
            Case "Label3"
                OLEObj.Left = 192.75
            Case "Label4"
                OLEObj.Left = 279
            Case "Label5"
                OLEObj.Left = 365.25
            Case Default:
       End Select
    Next

    Application.ScreenUpdating = True

End Function

---

除了.Left属性不会像我上面所说的那样以固定的间隔出现之外，这是可行的。但是，我可以使用您的想法命名和设置其他参数，然后使用Select Case修改每个参数的.Left。我只是尝试了一下，第一次和第二次都成功了，然后我发现错误对象库无效，或者包含对找不到的对象定义的引用。稍后我将更新上面的代码。控件似乎有两个名称，这可能会混淆问题，因此它搜索的名称和它实际的名称可能会不同-我猜这就是为什么您会收到错误消息的原因。我将创建控件，然后循环遍历它们，并将它们放置在您想要的位置。我已经更新了上面的代码来实现这一点……这是控件有趣的特性。如上所述，在我的更新中，我创建了控件，然后放置了它们，但如果我尝试删除现有对象，然后插入标签，经过2次迭代后，我会得到相同的错误“Object library invalid”。