vbadynamic删除范围内的checkbox

如果范围不是空的，我有一个工作表添加checkbox。 但也是我想要的是，如果这个范围减less其值（例如从5到3），我想要删除这些其他checkbox。

例如，我有4个填充行，我的代码添加了4个checkbox：

但后来我删除了2行，所以我期待这些checkbox也被删除，但是当我再次运行代码时，我仍然得到这些checkbox：

这是我迄今为止所尝试过的，其中的一部分是我从这个答案中拿出来的，但是它不起作用：

Option Explicit Sub AddCheckbox() Dim i As Long, lastrow As Long, rng As Range Dim ws As Worksheet Dim obj As OLEObject, cb As MSForms.CheckBox Set ws = Sheets("Consulta") lastrow = ws.Cells(Rows.Count, "E").End(xlUp).Row For i = 5 To lastrow If Not IsEmpty(ws.Range("E" & i, "J" & i)) Then For Each rng In ws.Range("D" & i) ws.OLEObjects.Add "Forms.CheckBox.1", Left:=rng.Left, Top:=rng.Top, Width:=rng.Width, Height:=rng.Height Next ElseIf IsEmpty(ws.Range("E" & i, "J" & i)) Then For Each obj In ws.OLEObjects If TypeOf obj.Object Is MSForms.CheckBox Then Set cb = obj.Object If cb.ShapeRange.Item(1).TopLeftCell.Address = _ ActiveCell.Address Then obj.Delete End If Next End If Next End Sub 

任何build议将有所帮助！ 我真的相信这个问题是在下面的这个部分：

 If cb.ShapeRange.Item(1).TopLeftCell.Address = _ ActiveCell.Address Then obj.Delete End If 

Answer 1

这不是很好，但工作：

 Sub AddCheckbox() Const RW_START As Long = 5 Dim i As Long, lastrow As Long, rng As Range Dim ws As Worksheet, o As Object, v Dim obj As OLEObject, cb 'As MSForms.CheckBox Set ws = Sheets("Consulta") lastrow = 500 'ws.Cells(Rows.Count, "E").End(xlUp).Row '^^^ not sure what would be the best approach here... For i = RW_START To lastrow If Application.CountA(ws.Range("E" & i & ":J" & i)) > 0 Then With ws.Range("D" & i) 'not already added a checkbox? If Len(.Value) = 0 Then Set o = ws.OLEObjects.Add("Forms.CheckBox.1", _ Left:=.Left, Top:=.Top, _ Width:=.Width, Height:=.Height) 'create a name for the checkbox and link it to the cell v = Application.Max(ws.Cells(RW_START, "D").Resize(1000, 1)) v = v + 1 o.Name = "cbx_" & v .Value = v .Font.Color = vbWhite Debug.Print i, v End If End With Else On Error Resume Next ws.Shapes(ws.Range("D" & i).Value).Delete On Error GoTo 0 ws.Range("D" & i).Value = "" End If Next End Sub