共享工作簿删除CheckBox时触发Runtime Error 1004报错求助

嘿，这个问题我之前也碰到过——共享工作簿对表单控件的操作限制比你想象的严格得多，哪怕你没用到官方标注的禁用功能，删除CheckBox这类操作还是会触发1004错误，核心原因是Excel的共享同步机制在搞鬼。

为什么会报错？ #

共享工作簿的核心目标是保证多用户之间的内容同步，因此它会严格限制对表单控件对象的修改操作（包括删除、批量重命名等）。你的代码里cbox.Delete直接遍历删除所有复选框，这种改变控件结构的操作在共享模式下会被Excel的安全拦截机制阻止，从而抛出1004运行时错误。

解决方案1：临时解除共享（如果业务允许） #

如果你的场景允许临时独占工作簿，可以先解除共享，执行完控件操作后再重新开启共享。注意：这个操作需要确保没有其他用户正在打开该工作簿，否则会失败。

修改后的代码示例：

Private Sub RunMe()
 Const BOX_SIZE As Integer = 16
 Dim ws As Worksheet
 Dim cell As Range
 Dim cbox As CheckBox
 Dim i As Integer, j As Integer
 Dim boxLeft As Double, boxTop As Double
 Dim wasShared As Boolean
 
 '先记录工作簿原本的共享状态
 wasShared = ThisWorkbook.MultiUserEditing
 
 '如果是共享状态，先获取独占权限解除共享
 If wasShared Then
     ThisWorkbook.ExclusiveAccess
 End If
 
 'Select Worksheet
 Set ws = ThisWorkbook.Worksheets("Sunday")
 'Clear Ranges that will be changed when CheckBoxes are clicked
 ws.Range("F2:G116").ClearContents
 ws.Range("I2:K116").ClearContents
 'Call FillDown
 'Delete checkboxes
 For Each cbox In ws.CheckBoxes
     cbox.Delete
 Next
 'Add checkboxes
 For i = 2 To 116
     For j = 8 To 8
         Set cell = ws.Cells(i, j)
         With cell
             boxLeft = .Width / 2 - BOX_SIZE / 2 + .Left
             boxTop = .Height / 2 - BOX_SIZE / 2 + .Top
         End With
         Set cbox = ws.CheckBoxes.Add(boxLeft, boxTop, BOX_SIZE, BOX_SIZE)
         With cbox
             .Name = "CB" & i & j
             .Caption = ""
             .OnAction = "CheckBox_Clicked"
             .Placement = xlFreeFloating
         End With
     Next
 Next
 
 '如果原本是共享状态，操作完成后重新开启共享
 If wasShared Then
     ThisWorkbook.Save
     ThisWorkbook.SaveAs ThisWorkbook.FullName, AccessMode:=xlShared
 End If
End Sub

解决方案2：复用现有CheckBox（更适合长期共享场景） #

如果不能临时解除共享，最优方案是避免删除操作，直接复用现有复选框——通过修改它们的位置、名称、可见性等属性来适配需求，这样就不会触发共享模式下的删除限制。

修改后的代码示例：

Private Sub RunMe()
 Const BOX_SIZE As Integer = 16
 Dim ws As Worksheet
 Dim cell As Range
 Dim cbox As CheckBox
 Dim i As Integer, j As Integer
 Dim boxLeft As Double, boxTop As Double
 Dim cbIndex As Integer
 
 Set ws = ThisWorkbook.Worksheets("Sunday")
 'Clear Ranges
 ws.Range("F2:G116").ClearContents
 ws.Range("I2:K116").ClearContents
 
 '复用现有CheckBox，完全避免删除操作
 cbIndex = 1
 For i = 2 To 116
     For j = 8 To 8
         Set cell = ws.Cells(i, j)
         With cell
             boxLeft = .Width / 2 - BOX_SIZE / 2 + .Left
             boxTop = .Height / 2 - BOX_SIZE / 2 + .Top
         End With
         
         '有现成的CheckBox就复用，没有再新增
         If cbIndex <= ws.CheckBoxes.Count Then
             Set cbox = ws.CheckBoxes(cbIndex)
             With cbox
                 .Name = "CB" & i & j
                 .Caption = ""
                 .OnAction = "CheckBox_Clicked"
                 .Placement = xlFreeFloating
                 .Left = boxLeft
                 .Top = boxTop
                 .Width = BOX_SIZE
                 .Height = BOX_SIZE
                 .Visible = True '确保控件显示
             End With
         Else
             Set cbox = ws.CheckBoxes.Add(boxLeft, boxTop, BOX_SIZE, BOX_SIZE)
             With cbox
                 .Name = "CB" & i & j
                 .Caption = ""
                 .OnAction = "CheckBox_Clicked"
                 .Placement = xlFreeFloating
             End With
         End If
         cbIndex = cbIndex + 1
     Next
 Next
 
 '隐藏多余的CheckBox（如果有）
 If cbIndex <= ws.CheckBoxes.Count Then
     For i = cbIndex To ws.CheckBoxes.Count
         ws.CheckBoxes(i).Visible = False
     Next
 End If
End Sub

内容的提问来源于stack exchange，提问作者Cody Pace