vba VBA删除具有范围的按钮
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/22309677/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA Deleting buttons with a range
提问by m25
I'm trying to figure out how to delete all buttons within a range. I've seen plenty of examples on how to delete all buttons within a sheet but not a range. I created a range variable the contains every possible occurance of a button (this is used to reinitialize a form of variable size). The problem is that range doesnt support the object .Shapes or .Buttons.
我想弄清楚如何删除范围内的所有按钮。我已经看到了很多关于如何删除工作表中而不是范围内的所有按钮的示例。我创建了一个范围变量,它包含按钮的所有可能出现的情况(这用于重新初始化可变大小的形式)。问题是范围不支持对象.Shapes 或.Buttons。
Set totalTable = Range(ActiveCell, ActiveCell.Cells(1000, 1000))
For Each gen_btn In totalTable.Shapes
gen_btn.Delete
Next
Any help would be appreciated. Also, I can't use ActiveSheet becuase there are buttons which i want to keep and becuase the macro is called by a button. Hence the need for a range. Thank you.
任何帮助,将不胜感激。另外,我不能使用 ActiveSheet,因为我想保留一些按钮,并且因为宏是由按钮调用的。因此需要一个范围。谢谢你。
回答by ARich
This solution uses the Intersect
method to see whether the shape is in your range and deletes the shape if it is.
此解决方案使用该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
Note that this code will not only delete buttons, but will also delete other shapes. If this is a concern, you can add an If
statement to skip certain shapes. For example:
请注意,此代码不仅会删除按钮,还会删除其他形状。如果这是一个问题,您可以添加一个If
语句来跳过某些形状。例如:
If Not btn.Name Like "Picture*" Then '<~~Will skip pictures
or
或者
If Not btn.Name Like "*box*" Then '<~~Will skip textboxes
etc. This assumes that you haven't renamed the shapes since creating them.
等等。这假设您在创建形状后没有重命名它们。
回答by Bernard Saucier
I'll show you how to extract the "position" of a button (it's not optimal, but it works). Up to you to adapt it to make it work as it should. This will dislpay the row and column of the top-left cell touched by each button (in the ActiveSheet
) in successive message boxes.
我将向您展示如何提取按钮的“位置”(这不是最佳的,但它有效)。由您来调整它以使其正常工作。这将显示ActiveSheet
连续消息框中每个按钮(在 中)触摸的左上角单元格的行和列。
Sub Testing()
For Each butt In ActiveSheet.Buttons
MsgBox "Row : " & butt.TopLeftCell.Row & vbCrLf & "Column : " & butt.TopLeftCell.Column
Next butt
End Sub
回答by Rich
The complete code:
完整代码:
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
回答by MBWise
Commenting on answer by ARich (which was useful to me) since I couldn't add a comment directly. It misses setting btn_rng, but btn.TopLeftCell could be used instead. Also, I prefer btn.Type = msoPicture instead of btn.Name Like "Picture.
评论 ARich 的回答(这对我很有用),因为我无法直接添加评论。它没有设置 btn_rng,但可以使用 btn.TopLeftCell 代替。另外,我更喜欢 btn.Type = msoPicture 而不是 btn.Name Like "Picture.
Here is my method based on that:
这是我基于此的方法:
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