エクセルテンプレートに使用期限を設けたいのですが。

質問

VBAで何とかなりますでしょうか？
会社でシェアウェアとまではいきませんが、得意先との契約に関し、特約店契約を結ぶ変わりにエクセルテンプレートを提供していくという話が出ており、それを組み立てるよう指示されました。しかし、年間契約のためテンプレートの方に制約をつけるにはどうしたら良いかと思案しております。エクセルVBAで使用期限を設けることはできないのでしょうか？。
どなかかすみませんが教えてください！ほかに方法があればそれでも構いません。本当に困っております。

回答No.9

KenKen_SP · ベストアンサー

こんにちは。KenKen_SP です。

#7 でお待ち下さい、、と言ったのですが、うまくコーディング
できません（TT）

ロジックは同一なのですが、変更点はシェープではなく、シー
トを xlSheetVeryHidden という、通常操作では再表示できない
状態で隠す、、というものです。

Excelの保存コマンドをトラップして、上記のことを行い、
「マクロ無効で開く」対策とするのですが、これがなかなか、
うまくできません。

コーディングは進めてはいますが、時間がかかりそうです。

お待ちいただけるなら、完成後アップさせていただきますが、
あまりに、お待ちいただいてご迷惑でしたら、締め切って
下さい。

お礼

ありがとうございます。
話をふっておきながら質問を閉めることはちょっと考えてしますのですが、閉めないことによってKenKen_SP 様をあおるようになってしまう気もするので、ここは一旦閉めます。が、VBAでの質問を多分毎日上げていくようになると思いますので、（完成した際にで結構ですので）その質問の方ででも解答に出していただければ幸いです。なんだか難しい質問をなげかけ、時間を割かせてしまって申し訳ありません。
ここは閉めますが別の質問のほうでもどうそ宜しくお願いします。
有難うございました。

回答No.8

koma1000nin

これは温存しておいた回答ですが、実現できるか確認できていません。
参考回答ということにしてください。

例えば、あるセルを白色背景にして、そこへ白色文字で有効期限を記入します。これでチェックの仕組みはわからなくなりますし、印刷にも影響しません。
これは、期限が過ぎてパソコンのカレンダーを操作しようものなら、有無を言わさず重要な数式を一瞬でクリアしてしまうやりかたです。

具体的にはこんな方法になるでしょう。
┌─────┬─────┬─────┬─────┬─────┐
│　　Ｚ　　│　　Ｘ　　│　　Ｙ　　│　Ｚ－Ｘ　│　Ｚ－Ｙ　│
└─────┴─────┴─────┴─────┴─────┘
　有効期限　　今回日付　　前回日付

正しく使用していれば、

　　Ｚ ≧ Ｘ ≧ Ｙ かつ Ｚ－Ｘ ≦ Ｚ－Ｙ

が同時に成り立ちます。
この関係が成り立たないときはパソコンのカレンダーを操作したと判断して、重要な式を削除します。上記のセルを改ざんできないようにする方法はおわかりとおもいますが、次の通りです。

１）シート全体のロックを解除する。

・全セルを選択状態にする。
・[書式]→[セル]→[セルの書式設定]→[保護]
・"ロック"のチェックボックスを"オフ"にして"ＯＫ"

２）保護するセルをロックする。

・保護するセル範囲を選択。
・[書式]→[セル]→[セルの書式設定]→[保護]
・"ロック"のチェックボックスを"オン"にして"ＯＫ"

３）保護指定をする。

・[ツール]→[保護]
・保護対象を選択（シートでいいでしょう）
・パスワードを入力
・ＯＫ
・確認パスワードを入力
・ＯＫ

これで選択した範囲がロックされます。

但し書きですが、あくまでも私はエクセルのプロではありませんので、前回アクセス日付のセットの仕方とか、特定のセルをクリアする方法は他の方に募ってみてください。
なお同一日に複数回開くことを考えたら、日付は時刻も含んだNOW()関数を使用するほうがいいと思います。

お礼

ご回答感謝します。
参考にさせていただきます、有難う御座いました。

回答No.7

KenKen_SP

こんにちは。KenKen_SP です。

ご質問は、私にとって結構面白いテーマになっています。

#6のコードですが、、

結局、マクロを無効でひらけば、シェープが邪魔でもセルだけコピーして
新規ブックに貼り付ければ手間ですが、複製できてしまいますね。

プロテクトとしてはお粗末でした...すみません。

もうひとつ思いついたアイディアがありますので、よろしければ締め切らず
お待ち下さい。

お礼

＞プロテクトとしてはお粗末でした...すみません。

いえいえ私はKenKen_SPのおかげで大変助かりました。
しばらくは締め切りませんが、おかげ様で私の仕事のほうは形としてまとまりましたので、ゆっくりで結構ですよ。
ありがとうございました。

回答No.6

KenKen_SP

こんにちは。KenKen_SP です。

> 期限内にテンプレートを開くときにシートの保護をかけた状態にしたい...

上記の件の対応と、幾つかの機能を付け加え、コードを整理しました。結果
仕様変更になってしまいましたので、#5 のコードと差し替えて下さい。

あとは、都合にあわせて書き換えるなり、ボツにするなり、お好きなように
カスタマイズして下さい。

保護のオプションをEXCELのバージョンで条件分岐させると面白いかもしれま
せん。

Option Explicit

'Setting ------------------------------------------------------------
'シート保護パスワード
Const cstPasKey As String = "dummypassword123"
'使用期限
Const cstLimitDate As Date = #6/30/2005#
'Protect Shape 文字列
Const cstPrtShpStr As String = "プロテクトされてます。" _
　　& vbCrLf & vbCrLf & "マクロを有効にしてください。"
'--------------------------------------------------------------------
'

'EVENT: ブックを開くとき
Private Sub Workbook_Open()

　　Dim SH As Worksheet
　　If GetProtectInfo() = False Then
　　　　'Falseなら期限切れなので終了
　　　　MsgBox "期限切れです", vbCritical, "終了"
　　　　ThisWorkbook.Close SaveChanges:=False
　　Else
　　　　'True なら有効期限内
　　　　Call ProtectShape(False)　　'Protect Shape 削除
　　　　ThisWorkbook.Saved = True
　　End If

End Sub

'EVENT: 保存する前
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

　　If ThisWorkbook.Saved Then
　　　　'変更がなければ処理しない
　　　　Cancel = True
　　Else
　　　　'保存前処理
　　　　Call ProtectShape(True) 　　'Protect Shape描写
　　　　'イベント2重発生停止し、保存実行
　　　　Application.EnableEvents = False
　　　　ThisWorkbook.Save
　　　　Application.EnableEvents = True
　　　　'上書き保存＝保存だけしてブックを閉じない場合がある
　　　　Call ProtectShape(False) 'Protect Shape 削除
　　　　ThisWorkbook.Saved = True
　　　　Cancel = True
　　End If

End Sub

'Protect管理用シート制御関数
Private Function GetProtectInfo() As Boolean

　　Dim SH　As Worksheet
　　Dim tmp As Variant

　　'関数ディフォルト値
　　GetProtectInfo = False

　　'管理シート存在チェック
　　On Error Resume Next
　　'ダミーアクセス
　　tmp = ThisWorkbook.Sheets("ProtectInfo").Range("A1").Value
　　'エラーが発生したら初回起動なので管理用シート追加
　　If Err.Number <> 0 Then
　　　　On Error GoTo 0
　　　　Application.ScreenUpdating = False
　　　　Set SH = ThisWorkbook.Worksheets.Add
　　　　　　With SH
　　　　　　　　.Name = "ProtectInfo"
　　　　　　　　'再表示させないようVeryHiddenで隠す
　　　　　　　　.Visible = xlSheetVeryHidden
　　　　　　　　'初回起動日を保存
　　　　　　　　.Range("A1").Value = Date
　　　　　　End With
　　　　Set SH = Nothing
　　　　Application.ScreenUpdating = True
　　End If

　　'使用期限判定
　　Set SH = ThisWorkbook.Sheets("ProtectInfo")
　　tmp = CDate(SH.Range("A1").Value)
　　'Date関数の戻り値が FlagDate より小さい場合
　　'Windows の時計を巻き戻した可能性あり
　　If Date < tmp Or Date > cstLimitDate Then
　　　　GetProtectInfo = False
　　Else
　　　　'OKなら--->正常起動として本日の日付を記録
　　　　SH.Range("A1").Value = Date
　　　　GetProtectInfo = True
　　End If
　　Set SH = Nothing

End Function

'Protect Shape 描写制御
Private Sub ProtectShape(Flag As Boolean)

　　Dim SH　As Worksheet
　　Dim obj As Object

　　Call SheetProtection(False) 'シート保護解除
　　For Each SH In ThisWorkbook.Worksheets
　　　　If SH.Name <> "ProtectInfo" Then
　　　　　　'Protect Shape 削除
　　　　　　For Each obj In SH.DrawingObjects
　　　　　　　　If Left$(obj.Name, 7) = "Protect" Then
　　　　　　　　　　obj.Delete
　　　　　　　　End If
　　　　　　Next obj
　　　　　　'引数：Flag が True なら Protect Shape 描写
　　　　　　If Flag Then
　　　　　　　　Set obj = SH.Shapes.AddShape( _
　　　　　　　　　　msoShapeRoundedRectangle, 100, 100, 200, 100)
　　　　　　　　With obj
　　　　　　　　　　.TextFrame.Characters.Text = cstPrtShpStr
　　　　　　　　　　.TextFrame.HorizontalAlignment = xlCenter
　　　　　　　　　　.TextFrame.VerticalAlignment = xlCenter
　　　　　　　　　　'作業用にプリフィックス追加
　　　　　　　　　　.Name = "Protect_" & .Name
　　　　　　　　End With
　　　　　　End If
　　　　　　Set obj = Nothing
　　　　End If
　　Next SH
　　Call SheetProtection(True) 'シートを再保護
　　Set SH = Nothing

End Sub

'シート保護制御
Private Sub SheetProtection(Flag As Boolean)

　　Dim SH As Worksheet

　　Application.ScreenUpdating = True
　　For Each SH In ThisWorkbook.Worksheets
　　　　'initシートは除外
　　　　If SH.Name <> "ProtectInfo" Then
　　　　　　Select Case Flag
　　　　　　　　Case Is = True
　　　　　　　　　　SH.Protect _
　　　　　　　　　　　　Password:=cstPasKey, _
　　　　　　　　　　　　DrawingObjects:=True, _
　　　　　　　　　　　　Contents:=True, _
　　　　　　　　　　　　Scenarios:=True, _
　　　　　　　　　　　　UserInterfaceOnly:=True
　　　　　　　　　　SH.EnableSelection = xlUnlockedCells
　　　　　　　　Case Is = False
　　　　　　　　　　SH.Unprotect Password:=cstPasKey
　　　　　　End Select
　　　　End If
　　Next SH

End Sub

お礼

KenKen_SP様

本当に有難う御座います。
親切に教えていただいた上にわがままにもお付き合いくださり、大変感謝しております。
おかげ様でテンプレートのほうは形が出来、私の仕事は無事終わりました。
このモジュールを期にマクロ記述に関して、より深く勉強していこうと思います。

回答No.5

KenKen_SP

こんにちは。KenKen_SP です。

#4 のとおり、完全に EXCEL のファイルを保護することは不可能です。しかし、実際には簡易的ながら、下記のようなコードでも十分な保護の効果は得られるかもしれません。

マクロを無効で開くとシートの変更が一切できないし、[ Protect Shape ]と書かれたお邪魔シェープがでんとあります。これで事実上テンプレートを使うことはできないかと。

なお、コードの内容理解を容易にするため、必要以上にコメントが入っています。

【手順】

1.　あなたが作ったテンプレートファイルを「マクロ無効」で開く
2.　Visual Basic Editor の ThisWorkbook にコードをコピー＆ペースト
3.　VBE でプロジェクトを保護します（方法はWEB検索して下さい）
4.　EXCELに戻り、*.xlt 形式で保存します（または*.xls）

【備考】

今回のような使用期限の判定では、そのままDATE関数で比較すると Windows の時計を戻すことで、そのチェックを回避できてしまいます。
安直な方法なのですが、下記のコードでは正常起動時の日付をブック内部に記憶し、それと Windows の時計を比較することで対応しています。もし途中で Windows の時計を戻すと、記憶された日付と整合がとれなくなる、、、という仕組みです。

【追伸】

業務で使われるみたいですが、自己責任でお願いしますね。あと、プロジェクトを保護しないと、全然意味ないですから、くれぐれも忘れないで下さい。

'-------------------------ここからコード-----------------------------------

Option Explicit

'シート保護パスワード（長く分かり難いものを）
Const cstPasKey As String = "dummypassword123"
'使用期限(日付式を#で囲んで下さい）
Const cstLimitDate As Date = #6/30/2005#

'ブックを保存するまえ
Private Sub Workbook_BeforeSave( _
　　ByVal SaveAsUI As Boolean, Cancel As Boolean)

　　Application.ScreenUpdating = False
　　If ThisWorkbook.Saved Then
　　　　'変更がなければ処理しない
　　　　Cancel = True
　　　　'ThisWorkbook.Close SaveChanges:=False
　　Else
　　　　'保存前にシートを保護する
　　　　Call SheetProtect
　　　　'上書き保存コマンドのための処理
　　　　'イベント2重発生停止
　　　　Application.EnableEvents = False
　　　　　　'保存実行
　　　　　　ThisWorkbook.Save
　　　　　　'シート保護解除
　　　　　　Call SheetUnProtect
　　　　　　'既に自前で保存したので保存コマンドの実行を
　　　　　　'キャンセル
　　　　　　Cancel = True
　　　　　　'SheetUnProtectの実行で変更ありになって
　　　　　　'しまったのを戻す
　　　　　　ThisWorkbook.Saved = True
　　　　'イベント停止を解除
　　　　Application.EnableEvents = True
　　End If

End Sub

'ブックを開くとき
Private Sub Workbook_Open()

　　Application.ScreenUpdating = False
　　If InitWorkbook = False Then
　　　　'InitWorkbookがFalseなら期限切れ
　　　　MsgBox "期限切れです", vbCritical
　　　　ThisWorkbook.Close SaveChanges:=False
　　Else
　　　　'有効期限内の場合
　　　　Call SheetUnProtect
　　　　'SheetUnProtectの実行で変更ありになって
　　　　'しまうので戻す
　　　　ThisWorkbook.Saved = True
　　End If
End Sub

'ブック初期化関数
Private Function InitWorkbook()

　　Dim SH As Worksheet
　　Dim FlagDate As Date
　　Dim tmp As Variant

　　On Error Resume Next
　　'ダミーアクセス
　　tmp = ThisWorkbook.Sheets("init").Range("A1").Value
　　'エラーが発生したら初回起動
　　If Err.Number > 0 Then
　　　　On Error GoTo 0
　　　　'プロテクト情報記録用シート追加
　　　　Set SH = ThisWorkbook.Worksheets.Add
　　　　　　SH.Name = "init"
　　　　　　'再表示させない
　　　　　　SH.Visible = xlSheetVeryHidden
　　　　　　'初回起動日時を記録
　　　　　　SH.Range("A1").Value = Date
　　　　Set SH = Nothing
　　End If

　　Set SH = ThisWorkbook.Sheets("init")
　　'使用期限の判定
　　FlagDate = SH.Range("A1").Value
　　'Date関数の戻り値が FlagDate より小さいと
　　'Windows の時計を巻き戻したのかもしれない
　　If Date < FlagDate Or Date > cstLimitDate Then
　　　　InitWorkbook = False
　　Else
　　　　'OKなら--->正常起動した今日の日付を記録
　　　　SH.Range("A1").Value = Date
　　　　InitWorkbook = True
　　End If

　　Set SH = Nothing

End Function

'シート保護解除
Private Sub SheetUnProtect()

　　Dim SH　As Worksheet
　　Dim obj As Object

　　Application.ScreenUpdating = False
　　For Each SH In ThisWorkbook.Worksheets
　　　　If SH.Name <> "init" Then 'init シートは除外
　　　　　　'保護解除
　　　　　　SH.Unprotect Password:=cstPasKey
　　　　　　'シェープ削除
　　　　　　For Each obj In SH.DrawingObjects
　　　　　　　　If Left$(obj.Name, 7) = "Protect" Then
　　　　　　　　　　obj.Delete
　　　　　　　　End If
　　　　　　Next obj
　　　　End If
　　Next SH

End Sub

'シート保護
Private Sub SheetProtect()

　　Dim SH　　　　As Worksheet
　　Dim strShName As String

　　Application.ScreenUpdating = False
　　'現在のシート名を退避
　　strShName = ActiveSheet.Name
　　'一度シート保護を解除する
　　Call SheetUnProtect
　　For Each SH In ThisWorkbook.Worksheets
　　　　If SH.Name <> "init" Then 'init シートは除外
　　　　　　'画面をスクロール
　　　　　　SH.Activate
　　　　　　Application.Goto Reference:=SH.Range("A1"), Scroll:=True
　　　　　　'お邪魔シェープ書き込み
　　　　　　SH.Shapes.AddShape( _
　　　　　　　　msoShapeRectangle, 100, 100, 200, 100).Select
　　　　　　With Selection
　　　　　　　　.Characters.Text = "Protect Shape"
　　　　　　　　.HorizontalAlignment = xlCenter
　　　　　　　　.VerticalAlignment = xlCenter
　　　　　　　　'後で作業しやすいようにプリフィックス追加
　　　　　　　　.Name = "Protect_" & .Name
　　　　　　End With
　　　　　　'シート再保護(パスワード使用）
　　　　　　SH.Protect Password:=cstPasKey, UserInterfaceOnly:=True
　　　　End If
　　Next SH
　　'処理前のシートを再選択
　　Sheets(strShName).Activate

End Sub

お礼

おわう！ありがとうございます。
早速試してみました。これは感激です。
かなりご丁寧に記述していただき私のほうでも大変わかりやすくなっていたのでなおさら感激してしまいました。
ついでにお願いなのですが、期限内にテンプレートを開くときにシートの保護をかけた状態にしたいのですが、どうすればよいのですか？一応自分なりに解釈して付け加えたりしたのですが駄目でした。宜しければお教えください。
大変有難う御座いました。

回答No.4

KenKen_SP

こんにちは。KenKen_SP です。

papayuka さんもコメントされてますが、基本的に EXCEL の保護
機能は詳しい人にとってはザル同然です。
また、保護解除ツールが存在し、誰でも手に入れることができて
しまいます。

したがって、使用期限を設ける対象に EXCEL ブックを選ぶこと
自体、無理があるのです。

まあ、デジタルコンテンツは100％保護することは不可能ですか
ら、どこで妥協するか、、という問題になると思いますが。

このことを前提とし、全ての方が EXCEL の保護機能を回避する
術に精通しているわけではないので、「完璧ではないが、ある程度
の保護ができれば良い」ということであれば、下記をお試し下さい。

1.　大き目のシェープなどで、テンプレート全体を隠してしまう
2.　シートを保護する

次にマクロのロジックですが、

・ブックを開くときは、期限内ならAuto_Openでシートの保護を解除
　し、1.のシェープを非表示なり削除なりする
　期限を過ぎていたら、ブックを閉じる

・期限内でブックを閉じるとき、Before_Close イベントで1.の
　シェープを表示（復活）させ、シートを再保護してから、
　ブックを閉じる

このマクロが書けたら、 VBA プロジェクトを保護します。

シート保護およびプロジェクトの保護にはパスワードを使用して
下さい。特にシート保護のパスワードは長いものを使います。

以上で、マクロ無効で開いてもシートの保護が解除できないのと、
邪魔なシェープがテンプレートを使い物にならなくします。

ひとつのアイディアとして。

お礼

ご回答感謝します。
＃1さんのおっしゃる通りでマクロ記述をもっと勉強しないといけなさそうです。今のところは期限の設定と、それに関するメッセージボックスの表示、それにブックの保護を絡めて記述してみました。（よく検索したら過去の回答にありました。）
Before_Closeイベントというのがわからないので勉強してみます。ありがとうございました。

回答No.3

papayuka

#1です。

例に書いたマクロを試すくらいの知識はお持ちですか？
マクロを有効で開いてもらえるなら例に書いた程度のものでも期限の設定は出来ていますが、無効で開かれてしまったら、まったく動かないので何の制御も出来ないって事です。

従って無効で開かれてしまった時の対策が必要になります。
ここでコードを全部書いたとしても環境に合わせて修正が必要でしょう。
ある程度の知識が無いと厳しいと思います。

お礼

再度のご回答感謝します。
ありがとうございました。

回答No.2

koma1000nin

このサイトに、契約書の改ざんという題目で質問された方がおりました。
裁判官が情報処理方面に疎いため、改ざん書類が証拠採用されて敗訴したということですから、しっかりやってください。
回答にはなっていませんが、何が起きるかわかりませんので、老婆心まで。

お礼

ご回答感謝します。
お気持ちありがたく頂戴します。がんばってみます。

回答No.1

papayuka

マクロ無効で開かれたら無力に近いのです。
例えば、新規ブックを作り、標準モジュールに下記のマクロを書いて xlt で保存してもマクロ無効で水の泡です。

'----------------------------------------------------
Const myDate As Date = #6/19/2005#
Sub Auto_Open()
　If Date > myDate Then
　　 MsgBox "期限切れです", vbInformation
　　 ThisWorkbook.Close
　End If
End Sub
'----------------------------------------------------

完全とは行かないまでも、あまり詳しくない人なら下記のような方法でいけるかも。

シートを二枚用意して、一枚を表示用シートとして前面に、もう一枚はテンプレートシートとして非表示にしておき、ブックの保護とシートの保護を掛ける。

Open 時に Date を確認して、OKならマクロでパスワードを解除してから、テンプレートシートを別ブックとしてコピーしてテンプレートブックは終了させる。
マクロ無効の場合は表示用シートだけが見え、シートとブックの保護が掛かっているのでテンプレートシートは表示出来ない。
VBProjectにはもちろんパスワードを設定する。

お礼

早速のご回答感謝します。
？？？すみませんもう少し噛み砕いて説明していただいてもよろしいでしょうか。VBAは素人なものですみません・・
よろしくお願いします。