エクセルでシートを保護するマクロの関数化

質問

いつもお世話になっております。

先日ここで複数の人が使用するエクセル（Ver.2016）シートで、入力されたセルだけに保護をかける下記のコードを教わって使い始めたのですが、当方にとっては非常に有益な機能なので他のブック、シートでも簡単に使えるようにマクロ化して関数で使えるようにしたいと思ったのですが、シートにより保護対象の行数と列数がちがうのでこのままでは関数化しても意味がないことに気付きました。
また、特定のセルに適用する関数ではないのでどうやって使うのかもわからないことに気付きました。

やりたいことは、どこかのセルで　関数＝HOGO（範囲）、もしくは＝HOGO（範囲、パスワード ：省略可）のような使い方ができれば理想なのですが。
当方マクロはほとんど使えないので上記のようなことができるのかどうかもわからないのですが、もしできれば非常に便利な関数ですのでお知恵を拝借したく。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Const RowS = 16 'ロック範囲開始行
Const RowE = 500 'ロック範囲終了行’
Const ColS = 1 'ロック開始列
Const ColE = 8 'ロック終了行
Const MyPassword = "" 'パスワード（省略可）
Const MySheet = "入力表" '保護したいシート名
Dim RowCnt As Long
Dim ColCnt As Long

With ThisWorkbook.Sheets(MySheet)
.Unprotect Password:=MyPassword
For RowCnt = RowS To RowE
For ColCnt = ColS To ColE
If .Cells(RowCnt, ColCnt).Value <> "" Then
.Cells(RowCnt, ColCnt).Locked = True
Else
.Cells(RowCnt, ColCnt).Locked = False
End If
Next ColCnt
Next RowCnt
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
Password:=MyPassword
End With

End Sub

回答No.5

HohoPapa · ベストアンサー

>「実行時エラー’13’」
>「型が一致しません」
>とのこと。

>デバックを確認したら
>If MyCell.Value <> "" Then
>が黄色になってました。

エラーの理由は行くわかりません。

添付画像のように
シートが保護されていない状態で、
必要なセル範囲に「保護範囲」という名前を設定する必要があります。

>指定範囲の大きさは動作に影響するのでしょうか？
範囲が広いからという理由でエラーにはなりませんが
意味なく極端に広くした場合、ファイルサイズが大きくなり、
保存する時のレスポンスに大きく影響します。

お礼

思った通りの保護ができるようになりました。
何より最初のご回答で、対策が取れる事が早期に分かり助かりました。

本当に何度もご丁寧なご指導に感謝いたします！！！

補足

全く新しくTEST用Bookを作り、最初からやってみたらうまくいきました。
この方法はマクロ画面はC&Pだけで内容をいじらずにすむので当方にとっては非常にありがたい改良版です。

また、確かに保護範囲の大きさによって保存時間が非常に長くなることも試してみました。
行だけを30行程度指定しただけで10秒？（待てない）程度かかりました。（作業中は「応答なし」との表示が出ました。）

10列X500行だと2-3秒（許容範囲）で保存が終了しました。

最初のマクロで20列X500行で統一し必要に応じてマニュアルで範囲指定するか、改良版で都度範囲指定するかのどちらかでやっていくことにします。

回答No.4

mdmp2

No.1 です。

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
はイベントプロシージャですが、そのままではデバッグができないので、標準モジュールに変更して、デバッグしながら修正していって、動くようになりました。
ポイントは、「Constant xx = yy」で定数を宣言するのに、yyが変数になっているのがエラーの原因でした。

以下が動作したコードです。
行間にコメントを入れました。

Sub CellLock()
Row1 = Selection(1).Row
　'オリジナルの Const RowS は定数の宣言なので、マクロ実行前にセル範囲を指定して
　'開始/終了行・列を取得しようとすると定数ではないのでエラーになります。
　'そこで、Const を取り除いて、RowS にしてみましたが、RowS はRows という予約
　'変数と同じなので、エラーになります。そこで、Row1 としました。
RowE = Selection(Selection.Count).Row
　'ここも上記と同じ理由で、Const　を取り除きました。
Col1 = Selection(1).Column
　’ここも上記と同じ理由でConst を取り除き、変数名をColS からCol1 に変更しました。
ColE = Selection(Selection.Count).Column
Const MyPassword = "" 'パスワード（省略可）
Const MySheet = "入力表" '保護したいシート名
Dim RowCnt As Long
Dim ColCnt As Long
With ThisWorkbook.Sheets(MySheet)
.Unprotect Password:=MyPassword
For RowCnt = Row1 To RowE
　'上記の変更を受けて、RowS をRow1に変更しました。
For ColCnt = Col1 To ColE
　'上記の変更を受けて、ColS をCol1に変更しました。
CellValue = .Cells(RowCnt, ColCnt).Value
If .Cells(RowCnt, ColCnt).Value <> "" Then
.Cells(RowCnt, ColCnt).Locked = True
Else
.Cells(RowCnt, ColCnt).Locked = False
End If
Next ColCnt
Next RowCnt
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
Password:=MyPassword
End With
End Sub

まず、Sub CellLock() で動作するかどうか試してください。
動作するようでしたら、イベントプロシージャに切り替えてください。

お礼

何度もご丁寧な回答ありがとうございました。
今は手が空かないので時間ができたら再度内容をよく読んでTRYしてみます。

当方にもわかるように解説までしていただき感謝です！！！
ご回答の方法で当方でもなんとかやれそうですが自信と時間なしにつきご容赦を。

回答No.3

HohoPapa

>どこかのセルで　関数＝HOGO（範囲）、
>もしくは＝HOGO（範囲、パスワード ：省略可）のような使い方
>ができれば理想なのですが。

特定しない適当なセルに関数式を埋め
その関数の結果をVBAに渡すことは単純にはできません。
（ちょっとわかりにくい言い回しでごめんなさい）

予め固定な位置のセルに、
保護したい範囲を求めるための文字列を（適当な関数で）埋め
これをVBAが参照することはできますが
それでも汎用性が不十分と思います。

そこで、
保護したい範囲に名前を付け、その範囲をマクロが制御する
という対策を考えてみました。

紹介するマクロは
1枚目のシートの任意範囲に、
「保護範囲」という範囲名を設定し
この範囲をマクロの対象範囲にするものです。
これなら、汎用性が広がると思います。

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

　Const MyPassword = "" 'パスワード（省略可）

　Dim RowCnt As Long
　Dim ColCnt As Long
　Dim MyCell As Range

　With ThisWorkbook.Sheets(1)

　　.Unprotect Password:=MyPassword
　　For Each MyCell In Range("保護範囲")
　　　If MyCell.Value <> "" Then
　　　　MyCell.Locked = True
　　　Else
　　　　MyCell.Locked = False
　　　End If
　　Next MyCell
　　.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
　　Password:=MyPassword

　End With

End Sub

補足

HohoPapa-さん
何度もお世話になります。
単純にはいかないとのこと、やはりという感じです。（具体的にどうやって使うのか分かりませんでしたので）

ご回答やってみたのですが、下記エラーメッセージが出ました。

「実行時エラー’13’」
「型が一致しません」
とのこと。

デバックを確認したら
If MyCell.Value <> "" Then
が黄色になってました。

土日に考えたのですが、VBAは前回うまく動作したコードで1-500行目（あるいはシート全体：1048576行）を保護範囲にして、前回のご回答で、マニュアルでも別に保護範囲が設定出来るとの事なので、必要に応じて普通の保護（解除）をかけることで、マクロは1つにしてしまう方法でも当方の場合十分かとも思います。
指定範囲の大きさは動作に影響するのでしょうか？
500行と100万行では何か不利益はあるのでしょうか？
実際には1000行あれば、十分で実害はないのですが。

せっかくなので両方試してみたいので、今一度宜しくお願いします。
対象Bookが多いので、最初に一番作業し易い方法に統一して作業したいので。

当初の対象３ファイルは前回のコードで対象行だけ変えて処理し、完了報告済み。　ありがとうございました。

回答No.2

HohoPapa

ブックの1枚目（一番左のシート）が対象で
ロック範囲の設定セルを
　開始行　A1
　終了行　B1
　開始列　C1
　終了列　D1　とした場合の例です。

Option Explicit

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

　Const MyPassword = "" 'パスワード（省略可）

　Dim RowS As Long　'ロック範囲開始行
　Dim RowE As Long　'ロック範囲終了行’
　Dim ColS As Long　'ロック開始列
　Dim ColE As Long　'ロック終了行
　Dim RowCnt As Long
　Dim ColCnt As Long

　With ThisWorkbook.Sheets(1)

　　RowS = .Cells(1, 1).Value
　　RowE = .Cells(1, 2).Value
　　ColS = .Cells(1, 3).Value
　　ColE = .Cells(1, 4).Value

　　.Unprotect Password:=MyPassword
　　For RowCnt = RowS To RowE
　　　For ColCnt = ColS To ColE
　　　　If .Cells(RowCnt, ColCnt).Value <> "" Then
　　　　　.Cells(RowCnt, ColCnt).Locked = True
　　　　Else
　　　　　.Cells(RowCnt, ColCnt).Locked = False
　　　　End If
　　　Next ColCnt
　　Next RowCnt
　　.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
　　Password:=MyPassword
　End With

End Sub

お礼

いつもお世話になっております。
早々のご回答ありがとうございます。

これを試す前にNo3をいただきましたので、こちらは未着手ですみません。

回答No.1

mdmp2

「開始行、終了行、開始列、終了列」を定数で指定していますが、
マクロ実行前にセル範囲を指定し、
マクロでセル範囲（開始行、終了行、開始列、終了列）を取得するようにしてはどうですか？

Const RawS=Selection(1).Row
Const RowE=Selection(Selection.Count).Row
Const ColS= Selection(1).Column
Const ColE=Selection(Selection.Count).Column

お礼

ご回答ありがとうございます。

質問に張り付けたコードの範囲指定にあたる
Const RowS = 16 'ロック範囲開始行
Const RowE = 500 'ロック範囲終了行’
Const ColS = 1 'ロック開始列
Const ColE = 8 'ロック終了行

をご回答のコードに置き換えたのですが、エラーとなってしまいます。
ご回答の主旨は理解できるのですが、当方ＶＢＡほとんど出来ないので上記くらいしかできないのでご容赦願います。