[已解决]删除对象

sparkguo · 发表于 2013-5-25 10:15

本帖最后由 sparkguo 于 2013-5-25 10:38 编辑

按条件删除对象
详情见附件，谢谢各位大侠了。

最佳答案

hwc2ycy

2013-5-25 10:24

复制代码

hwc2ycy · 发表于 2013-5-25 10:22

复制代码

hwc2ycy · 发表于 2013-5-25 10:24

复制代码

sparkguo · 发表于 2013-5-25 10:35

hwc2ycy 发表于 2013-5-25 10:24

If Not Application.Intersect(objShp.TopLeftCell, rg) Is Nothing
这句代码能不能详细注释一下，

hwc2ycy · 发表于 2013-5-25 10:37

sparkguo 发表于 2013-5-25 10:35
If Not Application.Intersect(objShp.TopLeftCell, rg) Is Nothing
这句代码能不能详细注释一下，

直接把对像所在的左上角单元格与区域E3:F5，通过交集方法，如果有交集返回的就是交集的单元格，否则就是空。

那么的帅 · 发表于 2013-5-25 10:38

…………………………

hwc2ycy · 发表于 2013-5-25 10:38

Application.Intersect 方法
返回一个 Range 对象，该对象表示两个或多个区域重叠的矩形区域。

hwc2ycy · 发表于 2013-5-25 10:38

我说的交集，不如帮助里说的是重叠的部分。

hwc2ycy · 发表于 2013-5-25 10:55

本帖最后由 hwc2ycy 于 2013-5-25 10:56 编辑

增加互动，可以指定单元格区域。

Sub 删除对象()
Dim objShp As Shape
Dim rg As Range
Dim strMsg$
'Set rg = Range("e3:f5")
On Error Resume Next
Do
Set rg = Application.InputBox(prompt:="请选择要删除对象的单元格区域", Title:="删除指定单元格区域内的对象", Type:=8)
Err.Clear
Loop Until Not rg Is Nothing
On Error GoTo ErrorHandler
For Each objShp In ActiveSheet.Shapes
If Not Application.Intersect(objShp.TopLeftCell, rg) Is Nothing Then
strMsg = strMsg & objShp.Name & vbCrLf
objShp.Delete
End If
Next
If Len(strMsg) > 0 Then
MsgBox "删除的对象如下：" & vbCrLf & strMsg
Else
MsgBox "没有可删除的对象"
End If
exit sub
ErrorHandler:
MsgBox Err.Number & vbCrLf & _
Err.Description
End Sub

复制代码

sparkguo · 发表于 2013-5-26 14:27

hwc2ycy 发表于 2013-5-25 10:55
增加互动，可以指定单元格区域。

谢谢老师思路开拓了，

		自动登录	找回密码
密码			注册