今天给大家分享一段纯学习用途的 VBA 代码，实现「工作簿打开自动校验有效期 + 到期自动清理公式+代码"自毁"保护」，适合做临时文件、演示文件、试用版表格的期限保护，代码可直接复制修改使用。
全文只做技术分享、学习交流，不用于任何恶意破坏文件的行为。
一、代码逻辑
- 自动另存为普通的 xlsx 表格，即代码"自毁"保护
二、代码部分（文件自动校验）
打开Excel文件，按 Alt + F11 打开 VBA 编辑器，左侧双击 ThisWorkbook，把下面代码完整粘贴进去：
Private Sub Workbook_Open() Dim counter%, term As Date, chk, str As String str = "HAJTCFX" chk = GetSetting(str, "budget", "使用次数", "") If chk = "" Then term = "2026/7/31" SaveSetting str, "budget", "使用次数", Format(term, "0") '将值写入注册表 Else counter = DateDiff("D", Date, Val(chk)) '计算剩余天数 If counter <= 10 And counter >= 0 Then ElseIf counter < 0 Then DeleteSetting str, "budget", "使用次数" killme End If End IfEnd Sub
str = "HAJTCFX"，可自定义根据自己需要命名，用于注册表读写的"应用程序名"；
term = "2026/7/31"，可根据自己需要设置到期日期；
注册表路径地址：计算机\HKEY_CURRENT_USER\SOFTWARE\VB and VBA Program Settings
三、代码部分（自毁子程序）
Public Sub killme() On Error Resume Next Dim ss As String Dim ws As Worksheet Application.DisplayAlerts = False ss = FullName For Each ws In ActiveWorkbook.Worksheets ws.Cells.SpecialCells(xlCellTypeFormulas).ClearContents Next ws ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Split(ThisWorkbook.Name, ".")(0) & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ThisWorkbook.ChangeFileAccess xlReadOnly Kill ss ThisWorkbook.Close FalseEnd Sub
文件名含空格易出错：路径拼接、文件名拆分时会触发代码报错，导致 “自毁” 逻辑执行失败
改系统日期可规避检测：用户只需把电脑系统日期改回有效期内，就能继续使用文件；
对策：针对 "改系统日期" 的问题，可通过注册表记录最后一次操作日期做双重比对
禁用宏直接失效：若用户打开文件时选择 "禁用宏"，整个有效期校验逻辑会完全不执行
四、重要提醒（必看）
- 本文仅做Excel/VBA 技术学习分享，请勿用于恶意删除、破坏他人文件
- 代码仅清理公式，不会乱删数据，适合自用、演示文件的期限管控
