请教如何增加代码禁止删除 图片2感谢4楼fdd老师解答！

蔡明江

]由4楼fdd老师热心解决，谢谢[
color=Blue]如何  禁止删除对账清单工作表中的图片2
以下都是分别放在模块中的代码,此代码能运行,但是就是会完全删除掉图片2,不知如何解决.


Sub 导出对账清单()

清除对账清单网络公司数据有效性
Dim shn As String
Dim WSHShell As IWshRuntimeLibrary.IWshShell_Class '引用 Windows Script Host Object Model
Application.ScreenUpdating = False '关闭屏幕更新，加快代码运行
Set WSHShell = New IWshRuntimeLibrary.IWshShell_Class
strDesktopPath = WSHShell.SpecialFolders.Item("Desktop")
shn = InputBox("请输入你要导出的工作表名！导出工作表到桌面并将以导出的文件名命名!", "导出", ActiveSheet.Name)
If shn <> "" Then
Sheets(shn).Copy



With ActiveWorkbook.VBProject.VBComponents(ActiveWorkbook.Sheets(shn).CodeName) 'fdd2009-3-22加入代码 删除导出工作表的代码
.CodeModule.DeleteLines 1, .CodeModule.CountOfLines                             'fdd2009-3-22加入代码 删除导出工作表的代码
End With                                                                        'fdd2009-3-22加入代码 删除导出工作表的代码


Z = Sheet12.[l2] & Sheet12.[M2]
ActiveWorkbook.SaveAs strDesktopPath & "\" & "贵州AAB--" & Sheets(shn).[B1] & "往来结算对账清单" & Format(Now(), "YYYYMMDD") & "  " & Z & ".xls"
删除图形
ActiveWorkbook.Sheets(shn).[a1] = "TO"
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Application.ScreenUpdating = True
End Sub




Sub 删除图形()
Dim Sp As Shape, s%
For Each Sp In ActiveSheet.Shapes
Sp.Delete
Next
End Sub

[ 本帖最后由 蔡明江 于 2009-3-22 18:50 编辑 ]

fdd

Sub 删除图形()
Dim Sp As Shape, s%
For Each Sp In ActiveSheet.Shapes
if sp.name<>"图片名称" then'注意图片名称中可能有空格，因此代码中的名称要与实际的名称完全相同才行。
Sp.Delete
end if
Next
End Sub

蔡明江

SHUJU.rar (78.76 KB, 下载次数: 15)

2009-3-22 18:34 上传

点击文件名下载附件

简易数据

fdd

Sub 删除图形()
Dim Sp As Shape, s%
For Each Sp In ActiveSheet.Shapes
If Sp.Name <>"Picture 1" Then
Sp.Delete
End If
Next
End Sub

蔡明江

谢谢老师，代码功能实现了