VBA zum dynamischen Löschen von Kontrollkästchen aus einem Bereich

Question

Ich habe ein Blatt, wo ich CheckBoxes hinzufügen, wenn ein Bereich nicht leer ist. Aber was ich will ist, dass dynamisch, wenn dieser Bereich seinen Wert verringert (geht von 5 bis 3, zum Beispiel) Ich möchte diese anderen CheckBoxen löschen.

Zum Beispiel habe ich 4 gefüllt Zeilen und meinen Code hinzugefügt 4 Kontrollkästchen:

Aber dann löschte ich zwei Reihen, so dass ich es erwartet hatte diese Kontrollkästchen auch gelöscht wurden, aber wenn ich führen Sie den Code wieder ich noch diese Kontrollkästchen erhalten:

Dies ist, was ich versucht habe, so weit und ein Teil davon nahm ich von THIS Antwort, aber es hat nicht funktioniert:

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 

Irgendwelche Vorschläge helfen! Ich glaube wirklich, dass das Problem mit diesem Teil ist unten:

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

Answer 1

Dies ist nicht groß, aber funktioniert:

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