小邱 發問時間: 電腦與網際網路軟體 · 1 0 年前

EXCEL如何以巨集設定使用期限

請問EXCEL如何以程式碼設定該檔案之使用期限.在使用期限道後即不能再使用.謝謝

1 個解答

評分
  • 1 0 年前
    最佳解答

    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

    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

    說 明:

    Term 變數可指定使用期限的天數

    Term = 1 表示只能使用1天

    Term = 0 表示只能使用1次

    SaveSetting 及SaveSetting 等VBA函數只在以下的鍵值名稱下才有效,所以使用此方法比較會被別人破解

    HKEY_CURRENT_USERSoftwareVB and VBA Program Setting

    KillMe 程序也可以使用以下方法

    Sub KillMe()

    Dim objNB As Object

    Set objNB = Workbooks.Add

    With ThisWorkbook

    Open .Path & "xx.bas" For Output As #1

    Print #1, "Sub Temp"

    Print #1, "Workbooks(" & """" & .Name & """" & ").Close False"

    Print #1, "Kill " & """" & .Path & "" & .Name & """"

    Print #1, "Kill " & """" & .Path & "xx.bas" & """"

    Print #1, "ThisWorkbook.Close False"

    Print #1, "End Sub"

    Close #1

    objNB.VBProject.VBComponents.Import Filename:=.Path & "xx.bas"

    End With

    Application.OnTime Now(), objNB.Name & "!Temp"

    End Sub

    下面網站有更詳細的範例

還有問題?馬上發問,尋求解答。