エクセルで使用期限付きのブックを作成したい

ある日が来たらエクセルを開けなくなる様にしたいです！また、できたとして、開けなくなった後でも自分で使用期限を延長できるようなことってできるでしょうか？
もし、簡単なコードがあるようでしたら教えてください！
イメージはマクロ？VBA？か何かで、今日の日付を読み込んで、設定しておいた使用期限の日にちを過ぎるとシート？ブック？を開けなくなるようにする
と言った様な感じです！
開けなくなった後も打ち込んだマクロかVBAの使用期限日を変えれてば開けるようになるーなんてことはできないでしょうか？？
マクロ、vbaは全く触ったことがないので、できればどこをどうしてどこに打ち込むのかも教えていただきたいです！

エクセルのバージョンは最新のもので、
シートは3つほど使う予定です！
よろしくお願いいたします！

質問者からの補足コメント

• パスワード検索で解除する方法が見つかっても問題ない程度のものでいいです！
  とりあえずマクロとか知らない人がぱっと開いてあー期限切れで使えなくなっちゃったのかー
  程度のものを作りたいと思っています！

    補足日時：2019/08/06 09:33

No.6 ベストアンサー 回答者： enunokokoro 回答日時： 2019/08/07 18:55

No.3の回答者です。

再度のお礼に書かれたことは、具体的にどのようなものなの？

私自身マクロに精通しているわけではないですし、エクセルが得意
というほどのスキルを持ち合わせていません。
簡単なマクロならば、ネット上のものを参考にして少し作ることが
あるぐらいなので。

やりたいことを整理して、具体的な動作を新規質問でしてみては。
マクロを提示するにも具体性がないと、質問者さんのための応用も
できないと思いますよ。

シートの保護を解除できるとしても、すべての操作を許可するもの
ではないですよね。その場合、操作できるものを限定してシートの
保護をする必要があります。
https://vbabeginner.net/vba%e3%81%a7%e3%82%b7%e3 …

使用期限が来たら、シートの保護範囲をすべてにするのか、ブック
が開かなくなるのかなどの具体的にしたいことを整理して、新規に
質問してください。

その質問に私が回答するかどうかはわかりません。
スキル的に無理なら回答しませんので。

No.5 回答者： WindFaller 回答日時： 2019/08/06 18:51

>パスワード検索で解除する方法が見つかっても問題ない程度のものでいいです！

期限が切れた後は、ブックを開けるときは、別のiniファイルが必要です。
別のブックを立ち上げて起動はできません。
ただ、こういうものは、自己満足以上を越えることはないと思います。
たぶん、作った私自身が、その仕様を忘れてしまいます。

'//ThisWorkbook モジュールのみ
'注意-変更後は必ず、ショートカット Ctrl + S 　を行うこと。
Private Const PWS As String = "1234" & vbBack 'パスワード
Private Const ValidDate As Date = #8/31/2019# '使用期限
Private Declare Function MessageBoxTimeoutA Lib "user32" (ByVal hWnd As _
　Long, ByVal lpText As String, ByVal lpCaption As String, ByVal uType As _
　Long, ByVal wLanguageId As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)
Private myTime As Date
Private Sub Workbook_Open()
　Dim wb As Workbook
　Dim i As Long
　On Error GoTo ErrHandler
'' Stop 'デバッグ検査用ストッパー

　If Date > ValidDate Then
　　MessageBoxTimeoutA 0&, "期限が切れましたのでオープンできません。", "ValiCheck", vbMsgBoxSetForeground, 0, 3000 '3秒後に閉じます
　　If Dir(Left(PWS, 4) & ".ini") = "" Then
　　　Application.Quit
　　　ThisWorkbook.Close False
　　Else
　　　Application.OnKey "{F12}", "ThisWorkbook.OpenWindow"
　　　Exit Sub
　　End If
　End If
　For Each wb In Workbooks
　　If LCase(wb.Name) Like "*.xls[xm]" _
　　 And wb.Name <> ThisWorkbook.Name Then
　　　i = i + 1
　　End If
　Next
　If i > 0 Then
　　MessageBoxTimeoutA 0&, "ブックは同時に2つ開いてはいけません。", "WinCheck", vbMsgBoxSetForeground, 0, 5000 '5秒後に閉じます
　　ThisWorkbook.Close False
　End If
　Application.OnKey "^c", "" 'コピー 使えない
　Application.OnKey "^v", "" '貼り付け 使えない

　Windows(1).Visible = True
　Exit Sub
ErrHandler:
　Call ThisWorkbook.AppQuit
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
　Windows(1).Visible = False
　''ThisWorkbook.Save
　If Dir(Left(PWS, 4) & ".ini") <> "" Then
　 Kill Left(PWS, 4) & ".ini"
　End If
　Application.EnableEvents = True
　Application.Quit
End Sub

Sub OpenWindow()
　 Windows(1).Visible = Not Windows(1).Visible = True
End Sub
Sub AppQuit()
Sleep 1000 '1秒後に閉じる
Application.Quit
ThisWorkbook.Close False
End Sub

'
期限が切れた場合は、このブックと同じフォルダーに、パスワード4文字+".ini" 拡張子
例:1234.ini
というファイルを作ってあげます。画面には出てきませんが、ブックは終わっていません。必要に応じて、F12 キーを押せばシート全体が表れます。

このブックは、Copy　 &　Paste　が使えないようになっています。

なお、初歩的なことですが、リテラル値を入れる場合、日付なら、#2019/8/7# のように入力します。また、私は使っておりませんが、Worksheets(1).Visible = xlSheetVisible/ xlSheetHidden / xlSheetVeryHidden という組み込み定数を使うのが一般的です。

この回答へのお礼

大変便利なものを作っていただきありがとうございます！
私の作りたいものが明確になっていなかったので、再度質問させていただきます！
お時間とっていただきありがとうございます！

お礼日時：2019/08/07 19:06

No.4 回答者： enunokokoro 回答日時： 2019/08/06 13:48

No.3の回答者です。

お礼に関する追加回答です。
　　ActiveWorkbook.Unprotect "AAA" 'ブック保護解除
これでブックの保護は解除されますが、一連の処理した最後にある
　　ActiveWorkbook.Protect "AAA"
によって、ブックの保護を再設定しています。
なので、Sheet1が開いた状態でもブックの保護はされたままです。

このままでも保護できるのですが、期日を過ぎた場合に保護された
ブックの状態が何故か保護が解除されています。
なので、確実に保護を維持するために以下のように修正します。
　　ActiveWorkbook.Protect Structure:=True, Password:="AAA"
　　'ブックの保護を再設定
これなら保護が維持されるようです。

Private Sub Workbook_Open()
' 修正版
　If Date < "2019/08/31" Then 'ここで期限を決める
　　ActiveWorkbook.Unprotect "AAA" 'ブック保護解除
　　Sheets("Sheet1").Visible = True
　　Sheets("Sheet1").Activate
　　Sheets("Sheet2").Visible = False
　Else '----期限後ならばメッセージを表示
　　MsgBox "期限切れ"
　End If
　　ActiveWorkbook.Protect Structure:=True, Password:="AAA"
　　'ブックの保護を再設定
End Sub

一応追加として、ブックを閉じたときに元の保護状態のSheet2のみ
表示した保護を再設定するものも用意しました。
期間内で開けても、期間後に期限切れの状態にしたいためです。

Private Sub Workbook_BeforeClose(Cancel As Boolean)
　If Sheets("Sheet1").Visible = True Then
　　ActiveWorkbook.Unprotect "AAA" 'ブック保護解除
　　Sheets("Sheet2").Visible = True
　　Sheets("Sheet2").Activate
　　Sheets("Sheet1").Visible = False
　　ActiveWorkbook.Protect Structure:=True, Password:="AAA"
　End If
End Sub

保存以外を選択してもSheet2に切り替わったままです。
保存以外を選択した場合の処理はしていません。

この回答へのお礼

ありがとうございます！
パスワード入力を求められるのですが、期限が切れるまではパスワード入力は無しで、期限が切れたらパスワード入力が求められるようなものは難しいでしょうか。

シートに保護をしてブックのvba?でシートの保護を解除してー
のような。。。
何度も申し訳ありません。。。

お礼日時：2019/08/06 23:13

No.3 回答者： enunokokoro 回答日時： 2019/08/05 21:53

期限の行の書き方が問題みたいですね。

　If Now < "08/31/2019" Then 'ここで期限を決める
この書き方だと正しくないので「期限切れ」となります。
日付部分は
　If Now < "2019/08/31" Then 'ここで期限を決める
にしたほうが良いと思います。
http://officetanaka.net/excel/vba/tips/tips59.htm
私なら
　If Date < "2019/08/31" Then 'ここで期限を決める
にするか、変数を使って
　Dim 日付 As Date
　日付 = "2019/08/31"
　If Date < 日付 Then 'ここで期限を決める
にしますね。
https://www.tipsfound.com/vba/04008

Private Sub Workbook_Open()
　If Date < "2019/08/31" Then 'ここで期限を決める
　　ActiveWorkbook.Unprotect "AAA" 'ブック保護解除
　　Sheets("Sheet1").Visible = True
　　Sheets("Sheet1").Activate
　　Sheets("Sheet2").Visible = False
　Else '----期限後ならばメッセージを表示
　　MsgBox "期限切れ"
　End If
　　ActiveWorkbook.Protect "AAA"
End Sub

VBAのプロジェクトもパスワードで保護をしないと、上記マクロが
丸見え状態になりますよ。
https://www.relief.jp/docs/017816.html

ちなみに、今回のマクロでは[ブックの保護]がされていますので、
マクロを無効にして開いたとしてもブックの保護は残ります。
ですからSheet2のままで開くということですね。

これらのパスワードも検索すれば解除する方法が見つかります。
ですから、絶対に安全な方法ではないですね。

この回答へのお礼

期限切れ直りました！ありがとうございます！

あと、1点だけ質問させてください。
ActiveWorkbook.Unprotect "AAA" 'ブック保護解除
これは期限内なら勝手にAAAを入力して保護を解除するというものではないのでしょうか。
イメージとしては期限が来るまでは勝手にブックが開いて、
期限が来たらパスワードを入力を求められるようなものを作りたいのですが難しいでしょうか。

パスワード検索で解除する方法が見つかっても問題ない程度のものでいいです！
とりあえずマクロとか知らない人がぱっと開いてあー期限切れで使えなくなっちゃったのかー
程度のものを作りたいと思っています！

お礼日時：2019/08/06 09:32

No.2 回答者： WindFaller 回答日時： 2019/08/05 20:59

ふつう、ご質問のような場合は、かつては、Proffessional バージョンの IRMがついていたのですが、今は、有料ストレージで、シェアポイントを購入しなければなりません。

月額500円程度でも、なかなか個人では負担が掛かります。会社で設定するにしても、たぶん、本人確認の電話が来るはずです。英語の電話の場合もあります。Google Drive でも同様のものがあるかもしれません。

この件は、もう10年以上のテーマで、ネットで神様扱いされる人もマクロの挑戦していますが、定番が出ていません。それは、長い間、IRMが主流だったからです。

マクロで提供するのは、誰か作っていればよいけれども、急ごしらえで簡単にできるものではありません。そのように作られたものは役に立ちません。マクロを使わないようにすれば、開いてしまうようなものはダメです。

それでも、私が以前から考えたものは、2つのブックを用意して、キーファイル(ブック)　からプロテクトを解除して開けるようにするのです。

キーブックから仮のパスワード入力
-------------- 　　　　　　　-----------------------
キーブック　*---------------> オリジナル・ブック
---------------　本password　> -----------------------
マクロブック　(マクロでOpen)　　一般のマクロなしブック(プロテクト)

オリジナル・ブックをマクロブックにすると、マクロを停止すると思ったような働きをしなくなってしまいます。

10桁以上のパスワード(英数・大文字小文字・記号混在)でしたら、業者に頼んでも数週間は掛かるはずです。
本当は、キーブックから生成されるパスワードをその都度書き換えていく方法もあるのですが、万が一には開かなくなってしまいます。

また、空白文字を入れたフォルダー名にExcelファイルを入れると、それを手動で出すのは、簡単ではありません。なお、キーブックから、SaveAs (名前をつけて保存)などは、禁止させます。有効期限(expire)は、キーブックで判定します。

https://windows10-help.com/1024/
ファイル・フォルダーを隠す

この回答へのお礼

詳しいご説明ありがとうございます！
一応保護かけているんだなーってのがわかる程度のものを作ろうと思っていました！説明不足で申し訳ありません！
ご回答ありがとうございました！

お礼日時：2019/08/06 09:38

No.1 回答者： kuroki55 回答日時： 2019/08/05 03:04

下記サイトが参考になりませんか。

https://otasuke.goo-net.com/qa361737.html

この回答へのお礼

今月末を期限にしてやったつもりなのですが、
vbaのコードはこれであってるでしょうか？
Sheet1を非表示にして、ブックをAAAで保護するのですが、
開いたときにパスワードを求められて、入力すると期限切れと出るのですが、
何がだめなのでしょうか。。。
全く分かっていないので何が悪いのかさっぱりです。申し訳ありません。

excel開発タブの
Visual Basicを押して出てきた
Microsoft Visual Basicのプロジェクトのところの
ThisWorkBookをダブルクリックして出てきた画面
に下記コードを打ち込んでいます。
出てきた画面の上にあるドロップダウンの文字はWorkbookとOpenになっています。

Private Sub Workbook_Open()
If Now < "08/31/2019" Then 'ここで期限を決める
ActiveWorkbook.Unprotect "AAA" 'ブック保護解除
Sheets("Sheet1").Visible = True
Sheets("Sheet1").Activate
Sheets("Sheet2").Visible = False
Else '----期限後ならばメッセージを表示
MsgBox "期限切れ"
End If
ActiveWorkbook.Protect "AAA"
End Sub

よろしくお願いいたします。

お礼日時：2019/08/05 16:39