こんにちは。
希望に合うか分かりませんが作ってみました。
まず、動作の概要ですが初回起動時にレジストリにタイムスタンプを刻み使用期間をチェックします。
悪意を持ってシステム日付を変更される可能性も考慮起動毎に日付チェックを行います。
初期設定として「メニュー」「シート1」「シート2」・・・がありますがメニュー以外は非表示になっています。
マクロが有効になっていないとメニュー以外のシートは表示されません。
ブックを閉じるときにメニュー以外のシートを隠します。
ブックにはプロテクトが掛っていてコピーが出来ません。
VBAにはプロテクトが掛っていて意図的に改変されることはありません。
とりあえず一通り考えられる不正利用を防止すると思われます。
パスワードは全て共通で「123456」です。
こちらがコードになります。
-------------------------------------------
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'ON ERROR RESUME NEXT '動作確認用(実際はデバッグ画面表示用に使用
'終了時にメニュー以外のシートを隠す
Dim sh
ActiveWorkbook.Unprotect Password:="123456"
For Each sh In Worksheets
If sh.Name <> "メニュー" Then Sheets(sh.Name).Visible = False
Next
ActiveWorkbook.Protect Password:="123456"
End Sub
Private Sub Workbook_Open()
'ON ERROR RESUME NEXT '動作確認用(実際はデバッグ画面表示用に使用
'起動時に全シートを表示する。
'マクロを有効にしなければシートが表示できない。
Dim Reg_FinishDate As Date
Dim Reg_FinishTime As Date
Dim Reg_ThisDate As Date
Dim Reg_ThisTime As Date
If Len(GetSetting("Security", "Sample", "FinishDate")) <> 0 Then
Reg_FinishDate = GetSetting("Security", "Sample", "FinishDate") '登録されているレジストリを検索
Reg_FinishTime = GetSetting("Security", "Sample", "FinishTime") '登録されているレジストリを検索
End If
If Reg_FinishDate <> 0 Then
'2回目以降起動動作
Reg_ThisDate = GetSetting("Security", "Sample", "ThisDate")
Reg_ThisTime = GetSetting("Security", "Sample", "ThisTime")
If Reg_FinishDate <= Reg_ThisDate Then
If Reg_FinishTime <= Reg_ThisTime Then
MsgBox ("使用期限が切れています。")
'ActiveWorkbook.Close
Exit Sub '★動作確認用(実際は不要)
End If
End If
'悪意を持ってシステム日付を変更した場合
If Date <= Reg_ThisDate Then
If Time <= Reg_ThisTime Then
MsgBox ("不正使用です。")
'ActiveWorkbook.Close
Exit Sub '★動作確認用(実際は不要)
End If
End If
SaveSetting "Security", "Sample", "ThisDate", Date '現在のタイムスタンプ
SaveSetting "Security", "Sample", "ThisTime", Time '現在のタイムスタンプ
Else
'初回起動時動作
SaveSetting "Security", "Sample", "FinishDate", Date + 7 '最初に起動した時より7日後
SaveSetting "Security", "Sample", "FinishTime", Time '最初に起動した時間
SaveSetting "Security", "Sample", "ThisDate", Date '現在のタイムスタンプ
SaveSetting "Security", "Sample", "ThisTime", Time '現在のタイムスタンプ
End If
Dim sh
ActiveWorkbook.Unprotect Password:="123456"
For Each sh In Worksheets
If sh.Name <> "メニュー" Then Sheets(sh.Name).Visible = True
Next
ActiveWorkbook.Protect Password:="123456"
End Sub
-------------------------------------------
使用するレジストリは
HKEY_CURRENT_USER -> Software -> VB and VBA Program Settings -> Security 以降です。
不明な点がありましたらお願いします。
補足
内容は理解できました。 やはり大変なのですね。 実際に今やっているのは、7日後の期日をVBA内に記載し、 その期日が来たらシートを隠し、強制終了させてしまうという やり方をしています。 しかし、日付が狂っているパソコンがあることに気が付き、 7日後の期日をVBAに記載しても実際の日付とパソコンの日付が異なるので、その後も最大1年間使用できてしまうという問題が起きました。 パソコンの日付が狂っていても、ファイルが開いてから7日間経過したら、動作するVBAを組めればと思ったのです。 なんとかなりますか?