|
|
楼主 |
发表于 2012-1-14 10:20
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub 杀毒() '删除宏表
Dim FS As Object
Dim BK As Workbook
Dim SHT As Worksheet
Dim ifExist As Boolean
Dim s As String
On Error Resume Next
'判断是否存在StartUp,以ifExist标记
ifExist = False
If Dir(Application.StartupPath & "\" & "StartUp.xls") <> "" Then ifExist = True
If ifExist = False Then
For Each BK In Workbooks
If ifExist Then Exit For
For Each SHT In BK.Sheets
s = SHT.Name
If s Like "StartUp*" Then
ifExist = True
If MsgBox("发现StartUp！" & vbCrLf & "StartUp可能影响你的Excel！是否清除？", vbOKCancel) = vbCancel Then Exit Sub
Exit For
End If
If SHT.Type = xlExcel4MacroSheet Then '干掉宏表
ifExist = True
If MsgBox("发现宏表4.0！" & vbCrLf & "宏表4.0可能影响你的Excel！是否清除？", vbOKCancel) = vbCancel Then Exit Sub
Exit For
End If
Next SHT
Next BK
End If
'判断是否清除StartUp
If ifExist = False Then Exit Sub
'关闭StartUp.xls
Workbooks("StartUp.xls").Close False
'删除文件
Set FS = CreateObject("Scripting.FileSystemObject")
FS.DeleteFile Application.StartupPath & "\" & "StartUp.xls"
'删除宏模块StartUp
If Dir(Application.StartupPath & "\" & "StartUp.xls", vbDirectory) = "" Then MkDir (Application.StartupPath & "\" & "StartUp.xls") '防病毒
Application.DisplayAlerts = False
For Each BK In Workbooks
' BK.Sheets("StartUp").Delete
For i = BK.Sheets.count To 1 Step -1
s = BK.Sheets(i).Name
If s Like "StartUp*" Then BK.Sheets(i).Delete
If s Like "~ *" Then BK.Sheets(i).Delete
If BK.Sheets(i).Type = xlExcel4MacroSheet Then '干掉宏表
BK.Sheets(i).Delete
End If
Next i
BK.Save
Next BK
' Application.VBE.ActiveVBProject.VBComponents.Remove Application.VBE.ActiveVBProject.VBComponents("StartUp") 'StartUp
Application.DisplayAlerts = True
'恢复变量
Application.OnSheetActivate = ""
Application.OnKey "%{F11}"
Application.OnKey "%{F8}"
MsgBox "清除StartUp完毕,自动退出！"
' ThisWorkbook.Close
End Sub
|
|
楼主: 彭希仁
/1 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2012-1-2 21:24
