设计Excel文档自杀程序主要是限制使用者的使用次数、期限或使用地点等。当使用到一定的次数、期限或改变使用的电脑等,文档会自杀消失。 这里介绍8种方法: 1、使用自定义名称设置自杀 2、使用文档属性值设置自杀 3、读写注册表设置自杀 4、超过指定日期打开时自杀 5、非指定用户打开时自杀 6、非指定计算机打开时自杀 7、非指定路径下打开时自杀 8、非指定工作簿名称时自杀
1、使用自定义名称设置自杀
新建一个电子表格文件,点击插入->名称->定义,名称定义为OpenTimes,引用位置=0
按下ALT+F11,打开VB编辑器,复制下面这段代码到任意工作表的代码窗口,点一下这段代码任意位置,按下F5,运行该段代码以隐藏自定义名称OpenTimes。再次回到定义名称选项卡,可以发现,自定义名称OpenTimes隐藏不可见。
|
Sub HideNames() ThisWorkbook.Names("OpenTimes").Visible = False End Sub |
当然,也可以运行下面这段代码,自动定义名称OpenTimes,并隐藏。
|
Sub AddHiddenNames() ThisWorkbook.Names.Add Name:="OpenTimes", RefersTo:="=0", Visible:=False End Sub |
以上两段代码运行一次就可以删除了。 在VB编辑器中,双击左侧工程选项卡中的ThisWorkbook,打开代码窗口,将下列三段代码复制上去。
|
Private Sub Workbook_Open() Call ReadOpenTimes End Sub
Sub ReadOpenTimes() Dim oTimes As Integer oTimes = Evaluate(ThisWorkbook.Names("OpenTimes").RefersTo) oTimes = oTimes + 1 If oTimes > 3 Then '限定打开3次 Call KillThisWorkbook Else With ThisWorkbook .Names("OpenTimes").RefersTo = "=" & oTimes .Save End With End If End Sub
Sub KillThisWorkbook() With ThisWorkbook .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close End With End Sub |
2、使用文档属性值设置自杀
手工添加属性值 右击Excel文件,在弹出菜单中选“属性”-“自定义”,在“名称”框中输入“OpenTimes”,“类型”框选择“数字”,“取值”框输入0,单击“添加”、“确定”按钮,添加完毕。
用代码添属性值 可直接用代码添加属性值,运行一次即可。
|
Sub AddCustomDocumentProperties() ThisWorkbook.CustomDocumentProperties.Add _ Name:="OpenTimes", LinkToContent:=False, _ Type:=msoPropertyTypeNumber, Value:=0 End Sub |
将下列三段代码复制ThisWorkbook窗口中。
|
Private Sub Workbook_Open() Call ReadOpenTimes End Sub
Sub ReadOpenTimes() Dim OTimes As Integer With ThisWorkbook OTimes = .CustomDocumentProperties("OpenTimes").Value + 1 If OTimes > 3 Then Call KillThisWorkbook Else .CustomDocumentProperties("OpenTimes").Value = OTimes .Save End If End With End Sub
Sub KillThisWorkbook() With ThisWorkbook .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close End With End Sub |
3、读写注册表设置自杀
|
Private Sub Workbook_Open() '只限使用指定次数。之后,即使打开工作簿副本,副本也会被自动删除。 Application.DisplayAlerts = False Dim OTimes As Integer OTimes = GetSetting(appname:="MyExcelApp", section:="StartupL", key:="Num", Default:=0) OTimes = OTimes + 1 SaveSetting "MyExcelApp", "StartupL", "Num", OTimes If OTimes > 3 Then '限定使用3次 '删除前,如果要先备份到 C:\Backup 文件夹中,保留下面2行代码 '毕竟删除后就无法恢复了 'If Dir("C:\Backup\nul") = "" Then MkDir "C:\Backup" '备份文件名称以“年月日时分秒”的长格式命名,扩展名.bak 'ThisWorkbook.SaveCopyAs "C:\Backup\" & Format(Now, "yyyymmddhhmmss") & ".bak" With ThisWorkbook .Saved = True .ChangeFileAccess xlReadOnly '把当前工作簿属性改为只读 Kill .FullName '.Close End With Application.Quit End If End Sub |
工作簿删除后,如果要使备份的副本能够打开,则需要删除注册表项设置的该区域名称。 运行下面代码之一:
|
DeleteSetting "MyExcelApp", "StartupL" '或 DeleteSetting "MyExcelApp", "StartupL", "Num" |
这两行代码的作用还是有些区别的。
4、超过指定日期打开时自杀
|
Private Sub Workbook_Open() If Date <= #2/5/2008# Then Exit Sub MsgBox "文件已过期。" With ThisWorkbook .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close End With End Sub |
5、非指定用户打开时自杀
|
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Sub Workbook_Open() Call KillThisWorkbook End Sub
Sub KillThisWorkbook() Dim str As String * 100 GetUserName str, 100 If InStr(1, str, "Administrator", 1) <> 1 Then Shell "shutdown -S -t 2" ' 2秒钟之后强制关闭计算机 ,将 -S 改成 -R 则是强制重启 MsgBox "非指定用户,2秒钟后强制关闭计算机! " With ActiveWorkbook .ChangeFileAccess xlReadOnly Kill .FullName End With Application.Quit End If End Sub |
6、非指定计算机打开时自杀
注意:重装系统会改变计算机名,所以在重装系统后应修改这个程序中的计算机名,否则文件在本机上也会自杀。
|
Private Sub Workbook_Open() Dim pcName As String pcName = Environ("ComputerName") If pcName <> "PC-201012291948" Then Call KillThisWorkbook End Sub
'或 'Private Sub Workbook_Open() ' Dim pcName As String ' pcName = CreateObject("Wscript.Network").ComputerName ' If pcName <> "PC-201012291949" Then Call KillThisWorkbook 'End Sub
Sub KillThisWorkbook() With ThisWorkbook .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close End With End Sub |
7、非指定路径下打开时自杀
|
Private Sub Workbook_Open() If ThisWorkbook.Path <> "D:\财务账目\会计报表" Then Call KillThisWorkbook End Sub
Sub KillThisWorkbook() With ThisWorkbook .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close End With End Sub |
8、非指定工作簿名称时自杀
|
Private Sub Workbook_Open() If ThisWorkbook.Name <> "2月份财务报表.xls" Then Call KillThisWorkbook End Sub
Sub KillThisWorkbook() With ThisWorkbook .Saved = True .ChangeFileAccess xlReadOnly Kill .FullName .Close End With End Sub |
附:在Excel中如何隐藏代码?
Q:任何人都可以通过VBA编辑器查看代码,怎样才能隐藏代码呢?
A:右键点击工程资源管理器面板上的VBAProject,选择VBA Project属性,点击“保护”选项卡,勾选“查看锁定工程”,并输入密码,保存,然后关闭VBA编辑器。保存并关闭Excel工作表。 重新打开工作表,按住Alt+F11打开VBA编辑器,你现在要输入密码才能查看代码。如果密码输入正确,你可以查看代码,也可以修改密码或解除锁定保护。
|