エクセルの試用期限の設定について

質問

みなさん、こんにちわ！
以前にも質問させて頂き組み込んでみると出来たと思っていましたが出来ていませんでした。
たびたび申し訳ないですが教えてください。
エクセルのマクロファイルに試用期間を設けて所定日数経過するとそのファイル自体が一度開いて試用期間が過ぎましたとメッセージを表示させて終了するようにしたいのですが、やっぱりパソコンの内部時計の変更で開くものでしょうか？
パソコンの内部時計を変更しても開かないようにはできないものでしょうか？
具体的に教えて頂ければ大変ありがたいです。
たびたびすいませんが宜しく
現状のものを貼り付けておきます。
Private Sub Workbook_Open()

Dim t As String
Dim dt As Date

t = GetSetting("TestApp", "TestSection", "Issheet")
If t = "" Then
' レジストリ値がない。初めて実行されたと認識し、今日の日付をセット
t = Format(CLng(Now()))
SaveSetting "TestApp", "TestSection", "Issheet", t
' ダミーのランダム値をセット
SaveSetting "TestApp", "TestSection", "Issheetd", Right$(Str(CDbl(Now())), 5)
End If
dt = CLng(t)

If Now() > dt + 32 Then
' 初めて実行された日から32日以上経っている
MsgBox "試用期間が過ぎましたので終了します。"

' 本ブックをClose
For Each w In Application.Workbooks
w.Save
Next w
Workbooks.Close
End Sub

回答No.3

kenpon24 · ベストアンサー

用途や試用期間からしてシェアウェアか何かだろうに、コード書いてくれと・・・
お金を取るつもりなら、質問者さん自身の大幅なレベルアップが必要です。そんなに難しいロジックじゃないんだし、レジストリ書き込みなど高度な内容も扱っていますので。
コードもコンパイルエラーになるし、'本ブックをクローズ　で全ブックを閉じているし、理解してやっているのかが不安です。

元を改良したサンプルです。ただし、私はレジストリに余計な書き込みなどしたくなかったので、実際に書き込みテストは行っておりません。
ご自分で確認してください。
ところで、ダミー値をセットする目的は何ですか？
理由があるなら教えていただけませんか？

サンプル
Private Sub Workbook_Open()

Dim t As String
Dim tt As String
Dim dt As Date
Dim dtt As Long

t = GetSetting("TestApp", "TestSection", "Issheet")
tt = GetSetting("TestApp", "TestSection_zan", "Issheet_zan")

If t = "" Then
Exit Sub
End If

dt = CLng(t)
dtt = CLng(tt)

'日付が巻き戻った、32日以上経っている場合終了する
If CLng(Now()) < dt Or dtt < 0 Then
MsgBox "試用期間が過ぎましたので終了します。"

' 本ブックをClose <-全ブックをクローズするがよいのか？
For Each w In Application.Workbooks
w.Save
Next w
Workbooks.Close
End If

End Sub

Private Sub Workbook_Close()

Dim t As String
Dim tt As String

t = GetSetting("TestApp", "TestSection", "Issheet")
tt = GetSetting("TestApp", "TestSection_zan", "Issheet_zan")

If tt = "" Then
'レジストリ値がない。初めて実行されたと認識し、今日の日付をセット
t = Format(CLng(Now()))
tt = "32"
Else
'書き込み値をセット。暗号化が必要ならハッシュ関数を考えること
tt = CStr(CLng(tt) - (CLng(Now()) - CLng(t)))
t = Format(CLng(Now()))
End If

Range("D1") = t
'レジストリに値をセット
SaveSetting "TestApp", "TestSection", "Issheet", t
' ダミーのランダム値をセット
SaveSetting "TestApp", "TestSection", "Issheetd", Right$(Str(CDbl(Now())), 5)
'残日数を記述
SaveSetting "TestApp", "TestSection_zan", "Issheet_zan", tt
End Sub

それと、このままNo.2さんのおっしゃるとおり、
前回の使用日　　7/1
　使用期限　　　　7/10
　PCの日付　　　　7/17 → 7/10に変更
のようなケースには対応しきれません。

自動でタイムサーバ同期をするか・・・、
net time サーバー /set /yes

初回起動時に自身のショートカットまたはレジストリを書き換えるスクリプトをスタートアップに登録するか・・・

こんな動作をするマクロ、あんまり配布してほしくないなぁ。。
私ならレジストリ書き込みされるのも嫌です。

回答No.5

Azzz___

私も昔考えたことがあったので興味ある質問です。

手っ取り早いのは外部から日付情報を持ってくることだと思いますが、
更にその起動情報を外部に保存しておくと、より固いと思います。
質問者さんがHTML知識などお持ちならCGIで日付だけを吐き出す
HTMLを作って、そこの値を読み込み、更に保存させる方法です。
今では死語かもしれませんが、クラサバというやつですね。

ただ複数からのアクセスを想定するとどのPCからのアクセスか
固有にしておく必要がありますので
できるかは分かりませんが、そのときにExcelのシリアル値も
一緒に保存しておけば、いけそうだし、駄目なら
CGI等でクッキー使って埋め込んでおくのもいいかもしれません。
あるいは利用者にハンドル名を入れさせるのもいいかと思います。

ただしこの場合ネットワーク接続前提なので
スタンドアローンのPCではできないですので、更に別途対策が必要ですね。

そこでNo1さんとNo2さんのロジックを応用して

No2さん
　前回の使用日　　7/1
　使用期限　　　　7/10
　PCの日付　　　　7/17 → 7/10に変更

上記の情報に加え、毎回起動時の日付の書き込みを行えば、
日付を戻された時にエラー検知できるでしょう。
ただどのみちレジストリをいじられると意味がなくなりますので
レジストリの値を暗号化させるなどの仕掛けが必要になりますね。
もっともこの意味で言えば、レジストリである必要はないので
Cドライブ直下などにini的なファイルを置いてそこから読み込ませても
同じだし、同ブック内に非表示シート(メニューバーから表示できない)を作っても
意味合いは同じだと思います。
ただこの方法でも日付の書き込み先を見つけられたら確実性がなくなりますので
ガチガチにするという意味では
色々なパターンを考慮して行わなければならないので
100%は難しいと思いますし、
それを実装するにはお金取れる価値あるかなとか思います(笑)

コードの例示とかはすみませんがパスにてお願いします。

回答No.4

kenpon24

失礼、Thisworkbookのイベントだったか。

Private Sub Workbook_Close()を
Private Sub Workbook_BeforeClose(Cancel As Boolean)
にすること。

ちなみに現状ではレジストリキー自体を削除されたら対応しきれませんので悪しからず。

それと、タイトルを微妙に変えてのマルチポストはやめましょう

お礼

回答いただき誠申し訳ないです。
参考に頑張ってみます。
他投稿、以後気をつけます。

回答No.2

K-Sogacchi

＞パソコンの内部時計を変更しても開かないようにはできないものでしょうか？
そのレベルの問題を何とかするなら、外部の標準日付を取得するしか
ないでしょうね。
例えば、管理者以外は日付を変更できないようなサーバの日付を
参照するとか（NET TIMEコマンドとかで出来ましたっけ？
…あ、NET TIME使うなら起動時にサーバと日付を合わせるって手もあるな）、
ネットから標準日付を取得するとか（そっちは私はよくわかりません）。

ちなみに、ANo.1氏のチェック方法も役に立たないわけでは無いとは思いますが、
例えば以下のような場合に、うまく行かないと思います。
　前回の使用日　　7/1
　使用期限　　　　7/10
　PCの日付　　　　7/17 → 7/10に変更

回答No.1

kenpon24

やり方次第じゃないですか？
最初の日付だけを記録するのではなく、閉じる度に
最終使用日時と残日数を記録する。

起動時にNowをとって最終使用日時より戻っていたらNG、
＋残日数が0未満になったらNGのチェックをするようにするとかで、いかがでしょうか。

お礼

kenpon24さん、早速ご回答ありがとうございます。
なるほど。。。
VBA勉強中のため、すいませんが、具体的に教えていただけると助かるんですが・・