Question

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

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

我再次执行，前四个标签位于正确的位置，但第五个标签不在那里，并且有一个＆＃39; Label6＆＃39;在我的工作表的右侧。
我第三次执行，前三个标签和第五个标签位于正确的位置，但第四个标签不在那里，并且有一个＆＃39; Label6＆＃39;在我的工作表的右侧。
我第四次执行，前两个标签和最后两个标签位于正确的位置，但第三个标签不是＆＃39; Label6＆＃39;在我的工作表的右侧。
我第五次执行，第一个标签和最后三个标签位于正确的位置，但第二个标签不在那里，并且有一个＆＃39; Label6＆＃39;在我的工作表的右侧。
我执行了第六次，最后四个标签位于正确的位置，但第一次没有，并且有一个＆＃39; Label6＆＃39;在我的工作表的右侧。
我执行了第七次，它按预期工作

奇怪的是，如果我发表评论，请致电CreateLabels＆＃39;并分别执行CreateSearchScreen和CreateLabels subs，它每次都能正常工作。

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

有关如何追踪我做错事的任何想法都会受到赞赏。

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

更新 Sub CreateLabels的这个修改代码适用于2次迭代然后我得到错误＆＃34;对象库无效或包含对无法找到的对象定义的引用＆＃34;。这发生在Sub CreateSearchScreen（）的第一行。如果我手动删除标签并重新开始，它可以进行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

Answer 1

问题出现的原因是标签名称在创建时并不总是按顺序分配，名称似乎达到了标签6，而CASE选择中没有这样做。

然而，您正在循环遍历数组，那么为什么不使用它来分配您的标签和位置......

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

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

1 个答案: