如何用VBA设置EXCEL使用的有效期？[求助]

guweiping · 发表于 2003-8-14 09:37

如何用VBA设置EXCEL使用的有效期？请各位大侠献策！！！

guweiping · 发表于 2003-8-15 08:12

各位大侠, Help me ,please!

中國龍 · 发表于 2003-8-15 11:00

您好: 做了一個範例 Term 變數可指定使用期限的天數 Term = 0 '範例用 0 天第次一開啟本檔時,顯示使用期限 MsgBox "本檔案只能使用到" & TermDate & "日" & Chr(13) & "超過期限將自動銷毀" 請關閉檔案第二次開啟到期日是今天,所以檔案會自我刪除 Sub CheckFileDate() Dim Counter As Long, LastOpen As String, Msg As String Chk = GetSetting("Chinese dragon", "Budget", "Date", "") If Chk = "" Then ' Term = 1 '1 day(指定使用的天數) Term = 0 '範例用 0 天 TermDate = DateSerial(Year(Now), Month(Now), Day(Now)) + Term MsgBox "本檔案只能使用到" & TermDate & "日" & Chr(13) & "超過期限將自動銷毀" SaveSetting "Chinese dragon", "Budget", "Date", TermDate Else If CDate(Chk) <= Now Then DeleteSetting "Chinese dragon", "Budget", "Date" KillMe End If End If End Sub Sub KillMe() Application.DisplayAlerts = False ActiveWorkbook.ChangeFileAccess xlReadOnly Kill ActiveWorkbook.FullName ThisWorkbook.Close False End Sub 123456789

ebGUzaHZ.rar (8.01 KB, 下载次数: 872)

chengwei0730 · 发表于 2003-8-16 20:40

TO:中国龙下载了您的范例,用过一次就不灵了, 将上述代码复制使用也不行. 请指教是何原因? 谢谢!

中國龍 · 发表于 2003-8-16 21:48

您好: 這個程是我故意將使用期限設成 0 天檔案的密碼是:123456789 請將 Term = 0 改成您要的使用期限後存檔這樣下次開啟時就不會馬上刪除要等使用期限到了,檔案會自動刪除 KillMe 程序就時執行自我刪除的程式

chengwei0730 · 发表于 2003-8-17 10:02

以下是引用中國龍在2003-8-16 21:48:00的发言： 您好: 這個程是我故意將使用期限設成 0 天檔案的密碼是:123456789 請將 Term = 0 改成您要的使用期限後存檔這樣下次開啟時就不會馬上刪除要等使用期限到了,檔案會自動刪除 KillMe 程序就時執行自我刪除的程式

to:中国龙您好! 您以上所说的我已经早就试过了. 我在不启用宏时进入编辑器修改了TERM=2 存档后重新打开,出现提示信息, 但我再次关闭后打开该文件,提示信息却不会出现了, 另外我又修改TERM=1,存档后重新打开,提示信息也没有出现. 请教以上是什么原因? 谢谢!

[此贴子已经被作者于2003-8-17 10:02:43编辑过]

chengwei0730 · 发表于 2003-8-18 08:21

以下是引用chengwei0730在2003-8-17 10:02:00的发言： [quote]以下是引用中國龍在2003-8-16 21:48:00的发言： 您好: 這個程是我故意將使用期限設成 0 天檔案的密碼是:123456789 請將 Term = 0 改成您要的使用期限後存檔這樣下次開啟時就不會馬上刪除要等使用期限到了,檔案會自動刪除 KillMe 程序就時執行自我刪除的程式

to:中国龙您好! 您以上所说的我已经早就试过了. 我在不启用宏时进入编辑器修改了TERM=2 存档后重新打开,出现提示信息, 但我再次关闭后打开该文件,提示信息却不会出现了, 另外我又修改TERM=1,存档后重新打开,提示信息也没有出现. 请教以上是什么原因? 谢谢!

[此贴子已经被作者于2003-8-17 10:02:43编辑过]

[/quote]

guweiping · 发表于 2003-8-18 08:28

Thank you very much!!! Let me try!

中國龍 · 发表于 2003-8-18 13:08

以下是引用chengwei0730在2003-8-17 10:02:00的发言： to:中国龙我在不启用宏时进入编辑器修改了TERM=2 存档后重新打开,出现提示信息, 但我再次关闭后打开该文件,提示信息却不会出现了, 另外我又修改TERM=1,存档后重新打开,提示信息也没有出现. 请教以上是什么原因? 谢谢!

您好: 這個檔案您打開第一次時,就已經寫入註冊碼了,程式如下 SaveSetting "Chinese dragon", "Budget", "Date", TermDate TermDate:就是您打開的時間除非將註冊區的 "Chinese dragon", "Budget", "Date", TermDate 中的 TermDate 日期清除,否則是不會再出現使用期限的對話方塊的所以我在使用期限到達時,要刪除檔案前寫了這一句 DeleteSetting "Chinese dragon", "Budget", "Date" 如果您要測試程式碼,可再建一個程序 Sub DelSetting () DeleteSetting "Chinese dragon", "Budget", "Date" End Sub 就能刪除,存放在註冊區的"Budget", "Date"註冊碼 PS:建議要運用本範例,建議將 SaveSetting "Chinese dragon", "Budget", "Date", TermDate 中的Budget 作為變數,帶入檔名例如: Sub CheckFileDate() Dim Counter As Long, LastOpen As String, Msg As String Chk = GetSetting("Chinese dragon", "Budget", "Date", "") If Chk = "" Then ' Term = 1 '1 day(指定使用的天數) Budget=Dir(ThisWorkbook.FullName) Term = 0 '範例用 0 天 TermDate = DateSerial(Year(Now), Month(Now), Day(Now)) + Term MsgBox "本檔案只能使用到" & TermDate & "日" & Chr(13) & "超過期限將自動銷毀" SaveSetting "Chinese dragon", Budget, "Date", TermDate Else If CDate(Chk) <= Now Then DeleteSetting "Chinese dragon", Budget, "Date" KillMe End If End If End Sub 表達的不好請見諒!

chengwei0730 · 发表于 2003-8-18 17:53

TO:中国龙非常感谢您的不吝指教! 还有一个问题想麻烦您一下: 我不想在第一次打开时出现提示信息, 而是在有效期限要到前5天开始每天出现提示信息, 这个代码该如何修改呢? 请您指教! 谢谢!

		自动登录	找回密码
密码			免费注册