时间戳

首页 > 解决方案 > 按钮循环多次重复相同的按钮，并且 .delete 失败

vba - 按钮循环多次重复相同的按钮，并且 .delete 失败

问题描述

我在工作表上有一些使用宏创建的按钮，每次添加新项目时（本质上，它们是“删除此行”按钮和“创建列表”按钮）。

我使用For Each/Next循环编写了一个宏来删除与我单击的形状范围相交的所有按钮，但它不起作用。

我添加了一堆Debug.Print命令来查看发生了什么，结果让我很困惑。

For Each 循环一遍又一遍地点击相同的按钮，即使按钮被识别为与范围相交，删除功能也会失败，并且循环会再次重复相同的按钮。

我有 2 个问题：

  1. 有什么办法可以防止我的 For Each 循环一遍又一遍地重复相同的按钮？和
  2. 我做错了什么按钮没有删除？

这是我的代码：

Sub DeleteBtn()
    Dim i As Integer   'variable to keep track of how many loops we've done

    'returns the number of entries on my sheet
    NumTasks = Application.WorksheetFunction.CountA(Sheets("Tasks").Range("B7:B10000"))
    'uses the clicked shape to position the macro
    Set rctngl = ActiveSheet.Shapes(Application.Caller)
    'using topleftcell, this creates an address reference for the shape that called the macro
    With rctngl.TopLeftCell
        'sets this variable to hold the characters in the address for the clicked shape
        rctnglAdd = .Address
        ''''show shape address in immediate window
        Debug.Print "Rectangle location is " & rctnglAdd
        ''''sets this variable to hold the integer value of the clicked shape row
        rctnglRow = .Row
        ''''show shape row value in immediate window
        Debug.Print "Rectangle row is " & rctnglRow
        ''''sets a range to check against for button deletion
        Set btnRng = Sheets("Tasks").Range("$M$" & rctnglRow & ":$N$" & rctnglRow)
        ''''show range to check for intersect
        Debug.Print "Intersect Range is " & btnRng.Address
    End With

    i = 1     ''''sets i to 1 for the first time through the loop
    For Each btn In Sheets("Tasks").Buttons  ''''begin loop for every button in the sheet
        On Error Resume Next   'ignore errors
        newName = btn.Name    ''''This instance name is
        newAdd = btn.TopLeftCell.Address  ''''this instance address is
        Debug.Print "Round " & i & "!"   ''''Show loop number in immediate window
        ''''Show this instance address in immediate window
        Debug.Print "This Button's address = " & newAdd
        ''''Show this instance name in immediate window,
        Debug.Print "This Button's Name = " & newName
        ''''if this instance intersects with intersect range
        If Not Intersect(Range(newAdd), btnRng) Is Nothing Then
            ''''message to say button intersects
            Debug.Print "Button address " & newAdd & " intersects with delete range " & btnRng.Address
            ''''message to say button will be deleted
            Debug.Print "Deleting Button: " & """" & newName & """"
            ActiveSheet.Buttons("""" & newName & """").Delete ''''Original code was btn.delete
        End If
        i = i + 1     ''''increase i for next loop
    Next btn          ''''begin loop for next

End Sub

以下是当我使用 4 个按钮在工作表上运行即时窗口时显示的内容：

Rectangle location is $N$8
Rectangle row is 8
Intersect Range is $M$8:$N$8
Round 1!
This Button's address = $M$5
This Button's Name = Button 1139
Round 2!
This Button's address = $N$5
This Button's Name = Button 1144
Round 3!
This Button's address = $N$5
This Button's Name = Button 1144
Round 4!
This Button's address = $N$5
This Button's Name = Button 1144
Round 5!
This Button's address = $N$5
This Button's Name = Button 1144
Round 6!
This Button's address = $N$5
This Button's Name = Button 1144
Round 7!
This Button's address = $N$5
This Button's Name = Button 1144
Round 8!
This Button's address = $N$5
This Button's Name = Button 1144
Round 9!
This Button's address = $N$5
This Button's Name = Button 1144
Round 10!
This Button's address = $N$5
This Button's Name = Button 1144
Round 11!
This Button's address = $N$5
This Button's Name = Button 1144
Round 12!
This Button's address = $N$5
This Button's Name = Button 1144
Round 13!
This Button's address = $M$7
This Button's Name = Button 1175
Round 14!
This Button's address = $M$7
This Button's Name = Button 1175
Round 15!
This Button's address = $M$7
This Button's Name = Button 1175
Round 16!
This Button's address = $M$7
This Button's Name = Button 1175
Round 17!
This Button's address = $M$7
This Button's Name = Button 1175
Round 18!
This Button's address = $M$7
This Button's Name = Button 1175
Round 19!
This Button's address = $M$7
This Button's Name = Button 1175
Round 20!
This Button's address = $M$7
This Button's Name = Button 1175
Round 21!
This Button's address = $M$7
This Button's Name = Button 1175
Round 22!
This Button's address = $M$7
This Button's Name = Button 1175
Round 23!
This Button's address = $M$7
This Button's Name = Button 1175
Round 24!
This Button's address = $M$7
This Button's Name = Button 1175
Round 25!
This Button's address = $M$7
This Button's Name = Button 1175 
Round 26!
This Button's address = $M$8
This Button's Name = Button 1215
Button address $M$8 intersects with delete range $M$8:$N$8
Deleting Button: "Button 1215"
Round 27!
This Button's address = $M$8
This Button's Name = Button 1215
Button address $M$8 intersects with delete range $M$8:$N$8
Deleting Button: "Button 1215"
Round 28!
This Button's address = $M$8
This Button's Name = Button 1215
Button address $M$8 intersects with delete range $M$8:$N$8
Deleting Button: "Button 1215"
Round 29!
This Button's address = $M$8
This Button's Name = Button 1215
Button address $M$8 intersects with delete range $M$8:$N$8
Deleting Button: "Button 1215"
Round 30!
This Button's address = $M$8
This Button's Name = Button 1215
Button address $M$8 intersects with delete range $M$8:$N$8
Deleting Button: "Button 1215"
Round 31!
This Button's address = $M$8
This Button's Name = Button 1215
Button address $M$8 intersects with delete range $M$8:$N$8
Deleting Button: "Button 1215"
Round 32!
This Button's address = $M$8
This Button's Name = Button 1215
Button address $M$8 intersects with delete range $M$8:$N$8
Deleting Button: "Button 1215"
Round 33!
This Button's address = $M$8
This Button's Name = Button 1215
Button address $M$8 intersects with delete range $M$8:$N$8
Deleting Button: "Button 1215"
Round 34!
This Button's address = $M$8
This Button's Name = Button 1215
Button address $M$8 intersects with delete range $M$8:$N$8
Deleting Button: "Button 1215"
Round 35!
This Button's address = $M$8
This Button's Name = Button 1215
Button address $M$8 intersects with delete range $M$8:$N$8
Deleting Button: "Button 1215"
Round 36!
This Button's address = $M$8
This Button's Name = Button 1215
Button address $M$8 intersects with delete range $M$8:$N$8
Deleting Button: "Button 1215"
Round 37!
This Button's address = $M$5
This Button's Name = Button 1139
Round 38!
This Button's address = $N$5
This Button's Name = Button 1144
Round 39!
This Button's address = $M$7
This Button's Name = Button 1175
Round 40!
This Button's address = $M$8
This Button's Name = Button 1215
Button address $M$8 intersects with delete range $M$8:$N$8
Deleting Button: "Button 1215"

标签： vbaexcelfor-loopbutton

解决方案

在使用 MS Forms Buttons进行多次测试后，此代码对我有用。下面的代码无法识别ActiveX Buttons。

请注意，尤其是我删除了On Error Resume Next. 您永远不能使用该语句来调试代码，因为它会忽略所有错误。

Sub buttons()

    Dim btnRng As Range
    Set btnRng = Sheets("Tasks").Range("A1:Z100")

    Dim i As Long
    i = 1     ''''sets i to 1 for the first time through the loop

    Dim btn As Object
    For Each btn In Sheets("Tasks").buttons  ''''begin loop for every button in the sheet


        Dim newName As String
        newName = btn.Name    ''''This instance name is

        Dim newAdd As String
        newAdd = btn.TopLeftCell.Address  ''''this instance address is

        Debug.Print "Round " & i & "!"   ''''Show loop number in immediate window
        ''''Show this instance address in immediate window
        Debug.Print "This Button's address = " & newAdd
        ''''Show this instance name in immediate window,
        Debug.Print "This Button's Name = " & newName
        ''''if this instance intersects with intersect range


        If Not Intersect(Sheets("Tasks").Range(newAdd), btnRng) Is Nothing Then
            ''''message to say button intersects
            Debug.Print "Button address " & newAdd & " intersects with delete range " & btnRng.Address
            ''''message to say button will be deleted
            Debug.Print "Deleting Button: " & """" & newName & """"
            btn.Delete
        End If

        i = i + 1     ''''increase i for next loop

    Next btn

End Sub

推荐阅读