使用 VBA 删除数千个复选框答案

【问题标题】：Using VBA To Delete Thousands of Checkboxes使用 VBA 删除数千个复选框
【发布时间】：2016-08-13 11:05:07
【问题描述】：

不知何故，在我们拥有的一些电子表格中创建了成千上万个复选框。我不确定这是怎么发生的，但我们不能只在 Excel 2003 中打开 Excel 2010 中的工作表。我编写了一些 VBA 脚本来检查并删除额外的复选框，它适用于大多数文件。但是，某些文件似乎比其他文件有更多的复选框，并且脚本因内存不足错误而死亡。这是我的脚本：

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 会收集所有复选框，而且复选框太多，所以它会死掉。

有没有办法在不使用ActiveSheet.CheckBoxes 的情况下逐步检查工作表上的每个复选框？

【问题讨论】：

debug.print c 说什么？
如果您认为有太多，可以快速检查一下Dim c as Long。
我不认为 c 会被分配，因为它在该语句完成之前就死了。
我不认为我溢出了整数变量。我认为 Excel 正在尝试将许多复选框加载到 ActiveSheet.Checkboxes 对象中。
嗯，很确定 30K 超过了 int 类型？编辑：正如上面蝙蝠侠建议的那样，将其调暗为long。编辑：刚刚过去32K。

标签： vba excel

【解决方案1】：

我会尝试使用形状集合和迭代器的索引器：

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

【讨论】：

不错的解决方案，绝对值得尝试
这很好用！谢谢！虽然，最初的问题似乎是我溢出了我的整数字段。通过将其转换为 long 我没有得到错误，所以一些功劳也应该去@findwindow。
还有@brucewayne（无法在一条评论中标记 2 个用户）。

【解决方案2】：

来自this page，这行得通吗：

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

【讨论】：

不。正如我猜测的那样，复选框不是 OLEObjects。如果我使用上面的函数，cnt 为 0，但“cnt = ActiveSheet.CheckBoxes.Count”返回 25,429。