通過代碼添加的Excel ActiveX標籤具有奇怪的行爲

Question

我在使用ActiveX控件構建工作表時遇到了Excel崩潰問題。重建是痛苦的，即使經常保存頻率也很頻繁，所以我希望通過一個子控件構建控件，以便根據需要執行重建工作表。

下面的代碼，刪除所有現有的ActiveX控件，然後創建五個標籤作品，排序。在一張空白紙上的第一次執行很好。只是爲了測試它：

• 我再次執行，前四個標籤在正確的位置，但第五個不在那裏，並在我的工作表的右側有一個'Label6'。
• 我執行第三次，前三個標籤和第五個標籤位於正確的位置，但第四個標籤不存在，並且在我的工作表的右側有一個「Label6」。
• 我執行第四次，前兩個標籤和最後兩個在正確的位置，但第三個沒有在我的工作表的右側有一個'Label6'。
• 我執行第五次，第一個標籤和最後三個在正確的位置，但第二個不在那裏，在我的工作表的右側有一個'Label6'。
• 我執行第六次，最後四個標籤在正確的位置，但第一個不在那裏，並且在我的工作表的右側有一個'Label6'。
• 我執行第七時間和它的作品如預期

奇怪的是，如果我註釋掉「呼叫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 

UPDATE 爲子CreateLabels此修改代碼適用於2次迭代，然後我得到的錯誤「對象庫無效或包含對反對說找不到定義的引用」。這發生在Sub CreateSearchScreen（）的第一行。如果我手動刪除標籤並重新開始，它可以工作2次，然後出現同樣的問題。

更新2 我修改了代碼創建然後放置標籤，但同樣的問題出現後2次迭代。我沒有使用函數，但我不認爲這會影響事情。很奇怪，我可以單獨但是沒有執行的潛艇從子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 

末次

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 

UPDATE： 嘗試進一步的編輯之前，我將創建的所有對象。

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