日々エクセルの改善をやっています!
その日常で、「こんなエクセルツールがあったら良いな」と思ったツールを公開していく事にしました。
第一弾は「自動でセルを保護する」エクセルマクロ(VBA)です。
※2020/1/25に改良版を掲載しました。
目次
このツールを作った背景
大量のエクセル関数式を埋め込んだ時の事「関数ができたのは良いが、これって手動でセルのロックをするの無理だよね。」って事になりました。
数百程度のセルなら良いのですが、対象のセルは数千を超えてるし、関数が埋め込んであるセルの並びに統一性がないから無理。
そんな結論でした。
その時に温めていたアイディアをマクロにしました!
ぜんぜん複雑なものではありませんけど。
セルを保護する条件を検討
セルを保護する対象は、確実に候補に挙がるのは関数式ですね。
これはセルのHasFormulaプロパティがTrueのものを対象にすれば良いだけなので簡単です。
その他に保護したいのは、項目名あたりでしょうか。
でも、項目名をなにで判断するべきなのか??
人によってルールは違いそうなので、これは独断で下記に決まり。
- タイトルに色を付ける
- 項目名にタイトルと同じ色を付ける
もし背景色が気に入らなかったら、保護した後に消してください。(もっと良いアイディアが思い浮かんだら改善します。)
という事で、セルA1にタイトルを入力し背景色を設定。保護をしたい項目名なんかにセルA1と同じ背景色を設定する。その色が設定されているセルをロックする。
他のセルはロック解除する。
こんな感じで決まりです。
赤枠が保護対象のセルです。
セル「C4」「C5」には計算式が埋め込んであり、数式が表示されている状態です。
A1のタイトルに黄色の背景色を設定しており、その色と同じ背景色のセルも保護の対象となります。
自動でセルを保護するマクロはこんな感じ
仕様が決定したところで下記が完成のマクロとなる。
このマクロを実行した結果は一切保証しませんので、このマクロを実行させる場合は、実行対象のファイルは必ずバックアップをしてください!
Option Explicit Public Const CTITLE As String = "https://nekoca.com" Public Sub AutoLockCell() Dim rng As Range Dim strMsg As String Dim lngA1Color As Long On Error GoTo ERR_PROC '保護されている場合はメッセージ If ActiveSheet.ProtectContents Then strMsg = "シートが保護されています。" & vbCrLf & "メニュー「校閲」→「シートの保護の解除」を実行してください。" Call MsgBox(strMsg, vbExclamation, CTITLE) Exit Sub End If '実行確認メッセージ strMsg = "自動セルロックを実行しますか?" If MsgBox(strMsg, vbYesNo + vbInformation, CTITLE) = vbNo Then Exit Sub End If '動きを止める With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual .DisplayAlerts = False End With 'A1の色を取得 lngA1Color = ActiveSheet.Range("A1").Interior.Color 'A1が白の場合はマイナスをセットして、項目名の色付けはされないようにする If lngA1Color = RGB(255, 255, 255) Then lngA1Color = -1 End If 'UsedRange内のセルをループして取得 For Each rng In ActiveSheet.UsedRange If rng.HasFormula Then '数式:ロックする rng.MergeArea.Locked = True ElseIf rng.Interior.Color = lngA1Color Then 'A1の色と同色は項目名としてロックする rng.MergeArea.Locked = True Else 'その他:ロックしない rng.MergeArea.Locked = False End If Next '処理終了メッセージ strMsg = "処理が完了しました。" & vbCrLf & "メニュー「校閲」→「シートの保護」を実行してください。" Call MsgBox(strMsg, vbYesNo + vbExclamation, CTITLE) ERR_PROC: With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic .DisplayAlerts = True End With End Sub
このコードをエクセルのモジュールに張り付けて使用してください。
シンプルに改良しました
仕様を下記に変更しました。
- 関数式のセル:ロックする
- 背景色が白以外:ロックする
- それ以外:ロックしない
こちらの方が絶対にシンプルだと思います。
下記ソースです。
Public Sub AutoLockCell2() Dim rng As Range Dim strMsg As String Dim lngA1Color As Long On Error GoTo ERR_PROC '保護されている場合はメッセージ If ActiveSheet.ProtectContents Then strMsg = "シートが保護されています。" & vbCrLf & "メニュー「校閲」→「シートの保護の解除」を実行してください。" Call MsgBox(strMsg, vbExclamation, CTITLE) Exit Sub End If '実行確認メッセージ strMsg = "自動セルロックを実行しますか?" If MsgBox(strMsg, vbYesNo + vbInformation, CTITLE) = vbNo Then Exit Sub End If '動きを止める With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual .DisplayAlerts = False End With 'UsedRange内のセルをループして取得 For Each rng In ActiveSheet.UsedRange rng.Select If rng.HasFormula Then '数式:ロックする rng.MergeArea.Locked = True ElseIf rng.Interior.Color <> RGB(255, 255, 255) Then '白以外のセル:ロックする rng.MergeArea.Locked = True Else 'その他:ロックしない rng.MergeArea.Locked = False End If Next With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic .DisplayAlerts = True End With '処理終了メッセージ strMsg = "処理が完了しました。" & vbCrLf & "メニュー「校閲」→「シートの保護」を実行してください。" Call MsgBox(strMsg, vbYesNo + vbInformation, CTITLE) Exit Sub ERR_PROC: With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic .DisplayAlerts = True End With '異常終了メッセージ strMsg = "処理が失敗しました。" & vbCrLf & "エクセルの保存をしないでください。" Call MsgBox(strMsg, vbExclamation, CTITLE) End Sub
アドインに登録して使用すれば便利な事この上ないですよ。
また良いツールが思い浮かんだら公開していきます。