神马文学网自杀代码
来源：百度文库 编辑：神马文学网 时间：2024/04/29 18:03:15
制作带自杀功能的工作簿 视频 http://www.excelhome.net/post/448.htm
超过指定日期的自杀代码！！ Option Explicit
Sub KillThisWorkbook()
With ThisWorkbook
.Saved = True
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close
End With
End Sub
Private Sub Workbook_Open()
If Date > #11/18/2010# Then
Call KillThisWorkbook
End If
End Sub 要是清除件内容的话，先用录制宏，获得清除内容的代码，再加入一个一个时间判断语句：
if date>#2010-08-01# then "清除内容的代码"
最后将修改的代码 放在 thisworkbook下 ：
Private Sub Workbook_Activate()
代码
End Sub 打开三次后自我删除
Option Explicit
Sub readopentimes()
Dim opentimes As Integer
With Me
opentimes = .CustomDocumentProperties("opentimes").Value + 1
If opentimes > 3 Then
Call killthisworkbook
Else
.CustomDocumentProperties("opentimes").Value = opentimes
.Save
End If
End With
End Sub
Sub killthisworkbook()
With ThisWorkbook
.Saved = True
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close
End With
End Sub killthiswork 这个已测试不错 Private Sub Workbook_Open()
If Now() >= #9/15/2006# Then
ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill ActiveWorkbook.FullName
Application.Quit
End If
End Sub
Private Sub Workbook_Open() '工作簿打开就执行
Application.DisplayAlerts = False '关闭提示
Dim datee As Date定义datee '为日期
datee = #9/19/2006#为datee '赋值
If Date > datee Then '如果当前日期大于设定的日期
ThisWorkbook.Sheets("Sheet3").Delete '删除表sheets3
ThisWorkbook.Save '保存工作簿
Application.Quit '推出工作簿
End If
End Sub
超过指定日期的自杀代码！！ Option Explicit
Sub KillThisWorkbook()
With ThisWorkbook
.Saved = True
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close
End With
End Sub
Private Sub Workbook_Open()
If Date > #11/18/2010# Then
Call KillThisWorkbook
End If
End Sub 要是清除件内容的话，先用录制宏，获得清除内容的代码，再加入一个一个时间判断语句：
if date>#2010-08-01# then "清除内容的代码"
最后将修改的代码 放在 thisworkbook下 ：
Private Sub Workbook_Activate()
代码
End Sub 打开三次后自我删除
Option Explicit
Sub readopentimes()
Dim opentimes As Integer
With Me
opentimes = .CustomDocumentProperties("opentimes").Value + 1
If opentimes > 3 Then
Call killthisworkbook
Else
.CustomDocumentProperties("opentimes").Value = opentimes
.Save
End If
End With
End Sub
Sub killthisworkbook()
With ThisWorkbook
.Saved = True
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close
End With
End Sub killthiswork 这个已测试不错 Private Sub Workbook_Open()
If Now() >= #9/15/2006# Then
ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill ActiveWorkbook.FullName
Application.Quit
End If
End Sub
Private Sub Workbook_Open() '工作簿打开就执行
Application.DisplayAlerts = False '关闭提示
Dim datee As Date定义datee '为日期
datee = #9/19/2006#为datee '赋值
If Date > datee Then '如果当前日期大于设定的日期
ThisWorkbook.Sheets("Sheet3").Delete '删除表sheets3
ThisWorkbook.Save '保存工作簿
Application.Quit '推出工作簿
End If
End Sub
再给一个过期则删除工作簿(回收站都找不到)
Private Sub Workbook_Open()
Application.DisplayAlerts = False
Dim datee As Date
datee = #9/19/2006#
If Date > datee Then
ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill ActiveWorkbook.FullName
ThisWorkbook.Close False
End If
End Sub
再给一个过期则自动删除宏代码之文件
Private Sub Workbook_Open()
Application.DisplayAlerts = False
Dim datee As Date
datee = #9/19/2006#
If Date > datee Then
Dim strFilePath, strJunk As String
strFilePath = Excel.Workbooks.Item(1).FullName
Close #1
Open strFilePath For Binary As #1
strJunk = Space(LOF(1))
Put #1, , strJunk
ThisWorkbook.Saved = True
ThisWorkbook.Close
End If
End Sub