我正在试图弄清楚如何删除范围内的所有按钮。我已经看到很多关于如何删除工作表中的所有按钮而不是范围的示例。我创建了一个范围变量,它包含按钮的每个可能出现的位置(这用于重新初始化一个可变大小的形式)。问题是范围不支持对象.Shapes或.Buttons。
Set totalTable = Range(ActiveCell, ActiveCell.Cells(1000, 1000))
For Each gen_btn In totalTable.Shapes
gen_btn.Delete
Next
任何帮助将不胜感激。另外,我不能使用ActiveSheet,因为我想保留按钮,因为按钮调用宏。因此需要一个范围。谢谢。
答案 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