先日の、
この件。結局またシフトファイルが重くなっており、完全にぶっ壊れてんなと思ったので、ちゃんと正常動作してた頃のファイルを複製し、新たに原本を作っておいた。
だが、ただ原本を作って、「絶対上書きしないでね(^o^)」なんて言ったところで上書きする奴はする。それをやられたのが以前の事だ、だから破損ファイルのコピー連鎖なんていうクソみたいな事態が起こった。
口で言っても無駄なのだ。もっと根本的に対処せよ。もう二度と面倒にならんように。
ではどうするのか。
手段を無くせ。
可能を不可能にするのだ！！
＝＝＝＝＝
というわけで、2パターン出来上がった。
まずはやさしいVer.から。
Private Sub Workbook_Open()
ThisWorkbook.Activate
If ThisWorkbook.Name = ("【原本】20XX0Xファイル.xlsm") Then
ThisWorkbook.Saved = True
Workbooks.Open ThisWorkbook.FullName, ReadOnly:=True
End If
End Sub
たったこれだけ、非常に単純なものである。
【解説】
・開いたら即発動するように、コードはThisWorkbookのWorkbook_Openイベントに書く。
・Activateは、まかり間違って別ブック捕捉しないよう念の為入れているだけ(Workbook_Openイベントに書いてるんだから大丈夫だとは思うが)。
・ifで原本ファイルのファイル名と一致するかの条件分岐する。
→これはシート上のどっかのセルで指定してもいい。
例えば管理というシートのセルA1に原本のファイル名を入力しておく場合はこう↓
：If ThisWorkbook.Name = Sheets("管理").Range("A1") Then
・Savedで一旦保存するのは、保存しないと2重で開くからうんたら～といわれる為。2重警告にDisplayAlerts = Falseは効かない。※「～は既に開いています。2重に開くと、これまでの変更内容は破棄されます。～を開きますか？」
・最後に読み取り専用で開き直すだけ。
これでやさしいVer.は以上。
つまり読み取り専用だから上書きできない、という仕組みなわけだ。非常に控えめな仕様である。
次に、原本を開き、特定セル以外を編集しようとした時点で警告を発して勝手にファイル複製し流れで原本を閉じる鬼畜Ver.。
【前提】
このように、
A2とA3には年月が入力されている。
この年月のセルは、
こんな感じで、自動で来月値になるような計算式が入ってるので基本的に入力不要スタイルだ。
それぞれ長ったらしいif関数が入っているので、軽く解説。
※VBAの上書き防止システムにはほぼ無関係なのでどうでもいい場合はすっ飛ばしてくれ。
元々、シフトファイルの原本を上書きから死守するための話であるため、ここにはシフトに関わる計算式が入っている。具体的に言うと、来シフト用の年月が反映する仕組みだ。
A2年値：当月が12月なら当年+1、12以外なら当年になる。
A3月値：年と同様に当月が12月なら1を返し、それ以外なら当月+1を返し、加えて表示形式上ではなく、データ上2桁月にしたいので、10未満月は0を頭につけるよううに、10以上ならそのままみたいな面倒な条件分岐も入れている。
このA2、A3だけは原本でも弄っていいことにしている(なんとなく)。
すなわち、A2、A3以外のセルをイジったら発動させるわけだが、恐らくA2、A3を最初にクリックして編集する人なんてほぼいない。だからこそ、あえて計算式を入れておき、自動的に必要な値が反映するようにしているわけだ。※もっと優しくUserformを使うこともできるが、それをしないがための鬼畜Ver.でもある。
この辺は今回の上書き防止VBAと直接には関係しないので、適宜自分のファイルに応じて変更してくれ。
で、セルの編集判定で実行させるわけだから、鬼畜Ver.コードは対象シートのシートモジュール、Changeイベントにぶち込んでいく。
Private Sub Worksheet_Change(ByVal Target As Range)
ThisWorkbook.Activate
If Target.Address(False, False) <> "A2" And Target.Address(False, False) <> "A3" And ThisWorkbook.Name = ("【原本】20XX0Xファイル.xlsm") Then
togetu = ThisWorkbook.Path & "\" & Range("A2") & Range("A3") & "ファイル.xlsm"
If Dir(togetu) <> "" Then
MsgBox "既にファイルは存在します。"
ThisWorkbook.Close savechanges = False
Workbook.Open (togetu)
Else
Set fso = CreateObject("scripting.FileSystemObject")
fso.copyfile ThisWorkbook.FullName, togetu
MsgBox "複製しました。このファイルは閉じます。"
ThisWorkbook.Close savechanges = False
End If
End If
End Sub
鬼畜っつったけどそこまで鬼畜でも無いな。性格の悪さの中、見え隠れする若干の優しさが感じて取れる出来と言えよう。まあ絶妙にイラッとは来るが。
【解説】
・If Target.Address(False, False) <> "A2" And～＝もし、編集セルがA2でない、且つ、編集セルがA3でない、且つ、このブックが"【原本】20XX0Xファイル.xlsm"である場合。
※Target.Address(False, False)とは：通常Target.Addressだけだとセル番地に勝手に$がつく。すなわち絶対参照だ。これはデフォルトではRowAbsoluteとColumnAbsoluteという、行列絶対参照設定がTrueになってるため。今回はとりあえず例文としてRowAbsoluteとColumnAbsoluteをFalseにし相対参照にしたくなったので、falseにしているだけ。
(特に絶対相対問わない条件指定の場合、If Target.Address <> "$A$2" And Target.Address <> "$A$3" And ThisWorkbook.Name = ("【原本】20XX0Xファイル.xlsm") Thenという感じの式でもいい)
・次の条件分岐では、複製予定のファイル名と同名のファイル無いかを事前確認している(万が一既に存在しているのにも関わらず同名で複製してしまうと、問答無用で上書きされ非常に危険なため)。
ある場合→「既にあるがな」といったようなことをメッセージボックスでお知らせし、原本ブックは閉じた上で既に複製されているファイルを開く。
ない場合→複製し、「複製したからもう用は無いよねバイバイ」と言いながら半強制的に原本ブックを閉じる。なぜかこのときは複製後のファイルは開かない(自分で開けの意)。
以上。
これらさえあれば、ある程度上書きは防げるだろう。
万が一、仕組みを知った上でどうしても上書きして邪魔したいような悪質野郎がいる場合は無理だろうが(ファイル名変えてしまえば無効化できるので)、多分あんまりいないはず、だよな。もしいるなら対抗する為に本物原本は隠しておき、バッチで原本を複製するとかしか方法は無いだろう(バッチも中身を見られたら終わりなのでVBS使用して非表示で…めんどくせ)。
というわけで、原本上書き保存奴にお困りの諸君。ぜひこれらをそれぞれの使用状況とお好みに合わせて、応用してみることをお勧めする｡
ちなみに我輩はやさしいVer.を使用。実は、鬼畜Ver.は考えた結果、没にした方の最初の案なのだ。鬼畜Ver.にすると、使えなくなった！とか思われそうだし嫌がられそうなんでな。
つか、原本書き換えたいと思ったやつが、読み取り専用原本を名前をつけて保存したあとに、元原本を削除、その後名前をつけて保存した方は元原本とは違う名前でそのまま原本として使用される＝読み取り専用にならない、ってことが普通に起こりそうだが、これはもういいやと妥協した。
もうそこまで防ごうとしたら色々制限がかかりすぎる。なるべく利用者の環境には大きな影響を与えない範囲で防止したいのだ。説明すんの面倒だしな。
