使用VBA删除数千个checkbox
不知何故，在我们拥有的一些电子表格中，有成千上万的checkbox被创build。 我不确定这是怎么发生的，但是我们无法在Excel 2003中打开工作表。 我写了一些VBA脚本来通过并删除额外的checkbox，它适用于大多数的文件。 但是，有些文件似乎有更多的checkbox比其他人和脚本死亡内存不足错误。 这是我的脚本：
Sub ProcessFiles() Dim Filename, Pathname, LogFileName As String Dim wb As Workbook Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Set log = fso.OpenTextFile("Z:\Temp\Fix.log", 8, True, 0) PrintLog ("*** Beginning Processing ***") Pathname = "Z:\Temp\Temp\" Filename = Dir(Pathname & "*.xls") Do While Filename <> "" PrintLog ("Opening " & Pathname & Filename) Set wb = Workbooks.Open(Pathname & Filename) DoWork wb PrintLog ("Saving file " & Pathname & Filename) wb.Close SaveChanges:=True Filename = Dir() Loop log.Close End Sub Sub DoWork(wb As Workbook) Dim chk As CheckBox Dim c As Integer With wb Worksheets("Vessel & Voyage Information").Activate PrintLog ("Getting count of checkboxes") c = ActiveSheet.CheckBoxes.Count PrintLog (c & " checkboxes found") If (c <= 43) Then PrintLog ("Correct # of checkboxes. Skipping...") Else c = 0 For Each chk In ActiveSheet.CheckBoxes If Not (Application.Intersect(chk.TopLeftCell, Range("D29:D39")) Is Nothing) Then chk.Delete c = c + 1 End If Next PrintLog ("Deleted " & c & " checkboxes.") End If End With End Sub Public Sub PrintLog(argument As String) If Not log Is Nothing Then log.WriteLine Format(Now(), "yyyy-MM-dd hh:mm:ss") & ": " & argument End If End Sub 该脚本在DoWork中的c = ActiveSheet.CheckBoxes.Count失败，或者，如果我注释该行，然后在For Each chk In ActiveSheet.CheckBoxes 。 我猜测，调用ActiveSheet.CheckBoxes收集所有的checkbox，有太多，所以它死亡。
有没有办法通过工作表上的每个checkbox，而不使用ActiveSheet.CheckBoxes ？
我会尝试使用形状集合和迭代器的索引器intead：
Sub DeleteCheckBoxes() Dim itms As shapes, i&, count&, deleted& Set itms = ActiveSheet.Shapes On Error GoTo ErrHandler For i = 1& To &HFFFFFFF If itms(i).Type = msoFormControl Then If itms(i).FormControlType = xlCheckBox Then count = count + 1 If count > 43 Then itms(i).Delete deleted = deleted + 1 i = i - 1 End If End If End If Next ErrHandler: Debug.Print "Count " & count Debug.Print "Deleted " & deleted End Sub
从这个页面 ，这个工作：
Sub Count_CheckBoxes() Dim cnt As Long Dim cbx As OLEObject cnt = 0 'Count CheckBoxes For Each cbx In ActiveSheet.OLEObjects If TypeName(cbx.Object) = "CheckBox" Then cnt = cnt + 1 End If Next End Sub