Question

我开发了以下两个subs，它们创建和删除listobject旁边的复选框集合。列表对象中的每个不同ID都会获得一个复选框。像这样，我可以批准listobject条目。

代码如下：

Public CBcollection As Collection
Public CTRLcollection As Collection

Sub create_chbx()
If Approval.CBcollection Is Nothing Then
Dim i As Integer
Dim tbl As ListObject
Dim CTRL As Excel.OLEObject
Dim CB As MSForms.CheckBox
Dim sht As Worksheet
Dim L As Double, T As Double, H As Double, W As Double
Dim rng As Range
Dim ID As Long, oldID As Long

Set CBcollection = New Collection
Set CTRLcollection = New Collection
Set sht = ActiveSheet
Set tbl = sht.ListObjects("ApprovalTBL")
Set rng = tbl.Range(2, 1).Offset(0, -1)
      W = 10
      H = 10
      L = rng.Left + rng.Width / 2 - W / 2
      T = rng.Top + rng.Height / 2 - H / 2

For i = 1 To tbl.ListRows.count
      ID = tbl.Range(i + 1, 1).Value
      If Not (ID = oldID) Then
            Set CTRL = sht.OLEObjects.Add(ClassType:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False, Left:=L, Top:=T, Width:=W, Height:=H)
            Set CB = CTRL.Object
            CBcollection.Add Item:=CB
            CTRLcollection.Add Item:=CTRL
      End If

      Set rng = rng.Offset(1, 0)
      T = rng.Top + rng.Height / 2 - H / 2
      oldID = ID
Next i
End If
End Sub


Sub remove_chbx()
If Not Approval.CBcollection Is Nothing Then
With Approval.CBcollection ' Approval is the module name
      While .count > 0
            .Remove (.count)
      Wend
End With
With Approval.CTRLcollection
      While .count > 0
            .Item(.count).Delete
            .Remove (.count)
      Wend
End With
Set Approval.CBcollection = Nothing
Set Approval.CTRLcollection = Nothing
End If
End Sub

这一切都很好。如果没有复选框，则没有双重复选框，也没有错误。我正在开发一个批准方案，我需要开发和测试其他模块。如果我现在运行这个子：

Sub IdoStupidStuff()
Dim i As Integer
Dim Im As Image

i = 1
Set Im = i
End Sub

它会给我一个错误。如果我然后尝试运行我的一个复选框，他们将无法正常工作。该错误将删除该集合，我无法再访问该集合。为什么会发生这种情况，我是否能够反击其他行为而不会导致错误？有没有更好的方法来实现这样的系统，收集的丢失不是问题？

Answer 1

您可以将Collection对象包装在Property中，让它处理对象创建：

Private mCollection As Collection

Public Property Get TheCollection() As Collection
    If mCollection Is Nothing Then Set mCollection = New Collection
    Set TheCollection = mCollection
End Property

要打电话：

TheCollection.Count

Answer 2

在导致错误的行之前尝试On Error Resume Next。它将跳过问题，您的可用物品仍然可用。但是，这不会解决您的错误。尝试在工作簿中创建一个单独的隐藏工作表来存储全局变量，这样它们就不会丢失。 f.ex。：

Private Sub CreateSheet()
    Dim ws As Worksheet
    With ThisWorkbook
        Set ws = .Sheets.Add(After:=.Sheets(.Sheets.Count))
        ws.Name = "Global"
        .Worksheets("Global").Visible = False
    End With
End Sub

错误后为什么公共变量会丢失？

2 个答案: