Excel VBA如何设置到期＂自毁＂保护
- 2026-11-09 23:34:50
Excel VBA如何设置到期＂自毁＂保护
今天给大家分享一段纯学习用途的 VBA 代码，实现「工作簿打开自动校验有效期 + 到期自动清理公式+代码"自毁"保护」，适合做临时文件、演示文件、试用版表格的期限保护，代码可直接复制修改使用。
全文只做技术分享、学习交流，不用于任何恶意破坏文件的行为。
一、代码逻辑
打开工作簿时，自动读取 / 写入有效期 实时计算剩余有效天数 到期后自动清除所有公式 自动另存为普通的 xlsx 表格，即代码"自毁"保护 全程无弹窗干扰，逻辑温和，仅做文件功能限制
二、代码部分（文件自动校验）
打开Excel文件，按 Alt + F11 打开 VBA 编辑器，左侧双击 ThisWorkbook，把下面代码完整粘贴进去：
Private Sub Workbook_Open()Dim counter%, term As Date, chk, str As Stringstr = "HAJTCFX"chk = GetSetting(str, "budget", "使用次数", "")If chk = "" Thenterm = "2026/7/31"SaveSetting str, "budget", "使用次数", Format(term, "0") '将值写入注册表Elsecounter = DateDiff("D", Date, Val(chk)) '计算剩余天数If counter <= 10 And counter >= 0 ThenElseIf counter < 0 ThenDeleteSetting str, "budget", "使用次数"killmeEnd IfEnd IfEnd Sub
str = "HAJTCFX"，可自定义根据自己需要命名，用于注册表读写的"应用程序名"；
term = "2026/7/31"，可根据自己需要设置到期日期；
注册表路径地址：计算机\HKEY_CURRENT_USER\SOFTWARE\VB and VBA Program Settings
三、代码部分（自毁子程序）
Public Sub killme()On Error Resume NextDim ss As StringDim ws As WorksheetApplication.DisplayAlerts = Falsess = FullNameFor Each ws In ActiveWorkbook.Worksheetsws.Cells.SpecialCells(xlCellTypeFormulas).ClearContentsNext wsActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Split(ThisWorkbook.Name, ".")(0) & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=FalseThisWorkbook.ChangeFileAccess xlReadOnlyKill ssThisWorkbook.Close FalseEnd Sub
文件名含空格易出错：路径拼接、文件名拆分时会触发代码报错，导致 “自毁” 逻辑执行失败
改系统日期可规避检测：用户只需把电脑系统日期改回有效期内，就能继续使用文件；
对策：针对 "改系统日期" 的问题，可通过注册表记录最后一次操作日期做双重比对
禁用宏直接失效：若用户打开文件时选择 "禁用宏"，整个有效期校验逻辑会完全不执行
四、重要提醒（必看）
本文仅做Excel/VBA 技术学习分享，请勿用于恶意删除、破坏他人文件 代码仅清理公式，不会乱删数据，适合自用、演示文件的期限管控 重要文件请先备份，再测试代码 注册表仅存储日期信息，不收集任何隐私数据
本文来自网友投稿或网络内容，如有侵犯您的权益请联系我们删除，联系邮箱：wyl860211@qq.com 。
