请帮忙给程序加一个时间保护

liuzhenhua

Sub 形成鉴定表()

Application.ScreenUpdating = False
    arr = Sheets("批量打印目录").Range("A2:A" & Sheets("批量打印目录").[A65536].End(xlUp).Row)
    For i = 1 To UBound(arr)
                Sheets("模板").Range("g9") = arr(i, 1)
        Sheets("模板").PrintOut
    Next
    Application.ScreenUpdating = True

End Sub
请给这个程序加个时间保护，允许程序在规定时间内才囊运行，超过时间（比如2024年6月12日）则显示“已过期”并停止运行
谢谢

3190496160

Private Sub Workbook_Open()
     If Date > #4/30/2024# Then MsgBox "The software has expired, please contact the author for authorization.！": ThisWorkbook.Close False
End Sub

3190496160

代码放到thisworkbook代码区域

LIUZHU

如果这个表格是发给别人用的，最好给VBA工程资源管理器再加一个密码，否则别人可以修改这个日期的啊

McCain2017

'代码放到ThisWorkbook代码区域

Sub Workbook_Open()
Dim dt
dt = #6/13/2024#
If Date >= dt Then
    With ThisWorkbook
        MsgBox "已过期!"
        .Close
    End With
'Else
'   MsgBox "还有" & dt - Date & "天过期"
End If
End Sub

ytmpgght

LIUZHU 发表于 2024-6-13 10:36
如果这个表格是发给别人用的，最好给VBA工程资源管理器再加一个密码，否则别人可以修改这个日期的啊

是的，除非使用者对宏一点也不会。

cai2532

这个添加日期过期保护密码很实用。