如何刪除一個單元格範圍內的所有複選框

Question

我有代碼刪除某個單元格中的複選框，但我需要它刪除我選擇的範圍內的所有複選框。以下是我的代碼，刪除了某個單元格中的複選框。

Columns("B:B").Select 
Selection.Find(What:="FIELD SERVICES", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate 
ActiveCell.Offset(1, -1).Select 
Dim CB8 As CheckBox 
For Each CB8 In ActiveSheet.CheckBoxes 
    If CB8.TopLeftCell.Address = ActiveCell.Address Then CB8.Delete 
    Next 

以下是我如何試圖改變它刪除單元格在我需要的範圍，但它僅刪除範圍內的第一個單元格的複選框。

Columns("B:B").Select 
Selection.Find(What:="FIELD SERVICES", After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate 
Range(ActiveCell.Offset(1, -1), ActiveCell.Offset(8, 0).Select 
Dim CB8 As CheckBox 
For Each CB8 In ActiveSheet.CheckBoxes 
    If CB8.TopLeftCell.Address = ActiveCell.Address Then CB8.Delete 
    Next 

任何意見是非常感謝。

Answer 1

Dim f as Range, cbRange as range 
Dim CB8 As CheckBox 


Set f = Columns("B:B").Find(What:="FIELD SERVICES", After:=ActiveCell, _ 
          LookIn:=xlFormulas, LookAt:=xlPart) 

if not f is Nothing then 
    set cbRange = f.parent.range(f.Offset(1, -1), f.Offset(8, 0)) 
    For Each CB8 In ActiveSheet.CheckBoxes 
    If not application.intersect(CB8.TopLeftCell, cbRange) is nothing Then CB8.Delete 
    Next 
end if