VBA删除带范围的按钮

时间:2014-03-10 19:38:49

标签: excel vba excel-vba

我正在试图弄清楚如何删除范围内的所有按钮。我已经看到很多关于如何删除工作表中的所有按钮而不是范围的示例。我创建了一个范围变量,它包含按钮的每个可能出现的位置(这用于重新初始化一个可变大小的形式)。问题是范围不支持对象.Shapes或.Buttons。

        Set totalTable = Range(ActiveCell, ActiveCell.Cells(1000, 1000))
        For Each gen_btn In totalTable.Shapes
           gen_btn.Delete
        Next

任何帮助将不胜感激。另外,我不能使用ActiveSheet,因为我想保留按钮,因为按钮调用宏。因此需要一个范围。谢谢。

4 个答案:

答案 0 :(得分:2)

此解决方案使用Intersect方法查看形状是否在您的范围内,如果是,则删除形状。

Sub Delete_Shapes_In_Range()

Dim btn As Shape
Dim totalTable As Range

Set totalTable = Range(ActiveCell, ActiveCell.Cells(1000, 1000))

For Each btn In ActiveSheet.Shapes
    If Not Intersect(btn_rng, totalTable) Is Nothing Then btn.Delete
Next btn

End Sub

请注意,此代码不仅会删除按钮,还会删除其他形状。如果这是一个问题,您可以添加If语句来跳过某些形状。例如:

If Not btn.Name Like "Picture*" Then '<~~Will skip pictures

If Not btn.Name Like "*box*" Then '<~~Will skip textboxes

等。这假设您在创建形状后没有重命名它们。

答案 1 :(得分:1)

我将向您展示如何提取按钮的“位置”(它不是最佳的,但它有效)。由您来调整它以使其按预期工作。这将使连续消息框中每个按钮(在ActiveSheet)中触摸的左上角单元格的行和列失效。

Sub Testing()

    For Each butt In ActiveSheet.Buttons
        MsgBox "Row : " & butt.TopLeftCell.Row & vbCrLf & "Column : " & butt.TopLeftCell.Column
    Next butt

End Sub

答案 2 :(得分:0)

完整的代码:

Sub DeleteRangeButtons()
rng = "A1:A10" ' Place range here. 
Dim btn As Button, ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
    For Each btn In ws.Buttons
    If isinrange(btn.TopLeftCell.Row, btn.TopLeftCell.Column, rng) Then
        btn.Delete
    End If
    Next btn
Next ws
End Sub
Function isinrange(x, y, rng)
    Cells(x, y).Activate
    If Intersect(ActiveCell, Range(rng)) Is Nothing Then
        isinrange = False
    Else
        isinrange = True
    End If
End Function

答案 3 :(得分:0)

评论ARich的回答(这对我有用),因为我无法直接添加评论。它错过了设置btn_rng,但可以使用btn.TopLeftCell。 另外,我更喜欢     btn.Type = msoPicture 代替     btn.Name喜欢&#34;图片。

以下是我的方法:

Public Sub DeleteIntersectingPictures(ByVal sheetToDeleteIn As Worksheet, ByVal rangeToLookIn As range)

    Dim noOfRowsInSheet As Long
    Dim pictureItem As Shape
    Dim pictureRange As range

    For Each pictureItem In sheetToDeleteIn.Shapes
        If pictureItem.Type = msoPicture Then
            Set pictureRange = sheetToDeleteIn.range( _
                pictureItem.TopLeftCell.Address & ":" & pictureItem.BottomRightCell.Address)
            If Not Intersect(pictureRange, rangeToLookIn) Is Nothing Then
                Call pictureItem.Delete
            End If
        End If
    Next pictureItem

End Sub