自作ツール(ExcelVBA)のセルの保護

2016年09月吉日 株式会社ワールドイッツマイン 代表取締役副社長 川上智弘

●エクセルの問題点及び本書の目的。

エクセルVBAを用いてツールを作成する人の殆どが、シートまたはセルの保護を施しているとおもいます。

純粋にボタンを押してマクロを実行するだけのものは、すべてのセルをロックしますし、

単票や一覧票の類は、入力可能項目のセルのロックを外し、

計算に依って算出される項目やラベル項目他のセルはロックするでしょう。

その上でシートの保護を掛ける事で、編集してはいけないエリアの不可侵処理を行います。

しかしながら、ロックが掛かっているセルは何をしても崩される事はありませんが、

ロックが掛かっていないセルは、[切り取り][貼り付け][フィル][クリア]処理で

仮にシートの保護が掛かっている場合でもセルの型が崩される場合があります。

[フィル][クリア]は悪意のある人間しかやらないので心配はほぼありませんが、

残りの二つは、単票入力等の場合にいくらでも行う事があり得るので

(誤って本来記入する必要がある項目の右隣に記入してしまい、切り取って本来のエリアに貼り付ける…等)

防止出来るならば防止したほうが宜しいと筆者は考えます。

早い話が、自作ツールを破壊から防ぐ手段です。

以下は筆者が考える最良の手段故、他に良い方法がいくらでもあるとおもいます。

あくまで参考程度に参照して頂けたら幸いです。

●手段その１

使用者全員に[切り取り][貼り付け]を絶対に行わない様に釘を刺す方法です。

上記の行為を行ってセルまたはツールが破壊されても一切責任を取らない旨を記入しておけば

万が一苦情が来ても、その苦情を突っ撥ねる事が可能です。

●手段その２

フォームを使用する方法です。

フォームの項目は絶対に破壊される事が無い為、新規にツールを作成する場合に非常に有効な手段です。

●手段その３

自作ツールに破壊を未然に防ぐマクロを組み込む方法です。

筆者がVBAの技術が未熟故、最良の方法では無い可能性が高いですが、

既存のツールがエクセルでありフォームに鞍替えする事が困難な場合や

どんなに釘を刺しても苦情だけは一人前のバカもいますので(現に何人もいました)、

その場合に参考にして頂けたらとおもいます。コードはVBAで記入してあります。

JavaやPerl等の最先端の言語を用いている方からしたら

VBAなど河原の小石の如く取るに足らない存在でしょうが、

進捗管理や品質管理はVBAで記述してある場合が多いので、そこは御容赦願います。

方法は大きく分けて二つ。

一つ目が[切り取り]、[コピー]、[貼り付け]自体を不可能にする方法。

二つ目がセルが破壊された瞬間に、そのセルの状態を元に戻す方法。

しかしながら一つ目は業務に支障が出るケースもありますので、二つ目の方法を以下に記載します。

[Alt]+[F11]にてVBAを起動して、[Microsoft Excel Objects]配下の

対象シートのコードを追加していく形になります。

Private Sub Worksheet_Changeにて

�@一旦、セルを全選択して色を(254,254,254)にする。

�Aヘッダー項目と入力可能欄のみ色を塗り潰し直し、Range.NumberFormatLocalを"@"にする。

�B全ての入力可能欄に名前定義を施す。

�C入力可能欄の文字列以外の項目のRange.NumberFormatLocalを適切なものに変える。

�DWorksheet_Changeにてフラグを設けて、

Ａ．・入力可能項目の色が白(255,255,255)以外。

・Range.NumberFormatLocalが不正値(例えば数値項目なのに文字列("@")等の数値以外が入っている)。

・名前定義が無くなっている入力可能項目がある。

・入力可能かつ結合セルの結合が解除されているセルが存在する。

・エクセルがコピー状態。

の内、一つ以上を満たす。

Ｂ．アンドゥ可能な状態。

ＡＢ共に満たした場合は、フラグを建てる。

�Eフラグが立っている場合はフラグを戻し、アンドゥする。

事で防止を図ります。

実際に筆者が即興で作成した単票ツールでコードの中身を見て行きます。

必要に応じて、ここからサンプル単票を墜として下さい。

コードは全て以下の単票マクロに最適化してありますのでご了承願います。

画面項目説明

個人単票

名前⇒

�@

部門⇒

�A

社員番号⇒

川上智弘

生年月日⇒

�B

会社Mail⇒

�C

血液型⇒

�D

趣味⇒

�E

好物⇒

�F

将来の夢⇒

�G

ラッキー�ａﾋ

�H

好きな色⇒

�I

好きな天候⇒

�J

描き足りない事があったら何でも好きに描いて下さい。。⇒

�K

赤い項目は必須入力、青い項目は任意入力です。

保存

初期化

終了

全て 終了

��

項目名称(名前定義)

種類

属性 (IME)

桁数 byte

横 位置

Tab Idx

I/O

必須

画面L��

初期値

チェック内容・ 編集内容

項目説明・備考

1

名前記入欄

TXT

全角

左詰

1

I

○

�@

2

部門記入欄

TXT

全角

左詰

2

I

○

�A

3

社員番号記入欄

TXT (R)

IME 無効

左詰

O

ログインID

4

生年月日入力欄

DATE

IME 無効

8

右詰

3

I

�B

YYYY/MM/DD

5

会社Mail入力欄

TXT

IME 無効

左詰

4

I

�C

6

血液型入力欄

CMB

IME 無効

2

左詰

5

I

�D

"O"、"A"、"B"、"AB"から1つ選択。

7

趣味入力欄

TXT

全角

左詰

6

I

�E

8

好きな物入力欄

TXT

全角

左詰

7

I

�F

9

将来の夢入力欄

TXT

全角

左詰

8

I

�G

10

数字入力欄

NUM

IME 無効

9,0

右詰

9

I

�H

0〜100000000の整数を入力可。

11

色入力欄

TXT

全角

左詰

10

I

�I

12

好きな天候入力欄

CMB

IME 無効

左詰

11

I

�J

"晴"、"快晴"、"雨"、"豪雨"、"曇"、"霧"、"雪"、"吹雪"、"熱波"、"砂嵐"、"暗闇"、"時化"、"上記以外"から1つ選択。

13

備考欄

TXT

全角

中央

12

I

�K

14

保存

BTN

必須入力チェック。

ブックを保存する。

15

初期化

BTN

ブックを初期化する。

16

終了

BTN

必須入力チェック。

ブックを保存終了する。

17

全て終了

BTN

必須入力チェック。

起動中の全てのブックを終了する。

18

？

BTN

？

上記の単票は�@〜�Kの入力可能セルはセルのロックが掛かっておらず、

その他のセルにはロックが掛かっており、その上でシートの保護を掛けています。

即ち�@〜�Kのみ進入及び編集可能となります。

以下は標準モジュール(Main)のコーディング(一部抜粋)です。

Option Explicit

Public Const MST1 = "名前記入欄"

Public Const MST2 = "部門記入欄"

Public Const MST3 = "生年月日入力欄"

Public Const MST4 = "会社Mail入力欄"

Public Const MST5 = "血液型入力欄"

Public Const MST6 = "趣味入力欄"

Public Const MST7 = "好きな物入力欄"

Public Const MST8 = "将来の夢入力欄"

Public Const MST9 = "数字入力欄"

Public Const MST10 = "色入力欄"

Public Const MST11 = "好きな天候入力欄"

Public Const MST12 = "備考欄"

Public ARYY As Variant '名前定義を格納する箱

Public FirstFlg As Boolean '起動時フラグ

Public PFlg As Boolean '他マクロ実行フラグ

Public PSPS As Boolean 'セル破壊判定フラグ。最重要。

'〜〜〜〜〜〜〜〜〜〜(中略)〜〜〜〜〜〜〜〜〜〜

Sub SingleC()  '名前定義破壊判定

Dim APPPP As Long

Dim MyName As Name

On Error GoTo DesTroy '名前定義が破壊されているなら、下のIF文でエラー発生。DesTroy以下に飛ぶ。

ARYY = Array("名前記入欄", "部門記入欄", "生年月日入力欄", "会社Mail入力欄", _

"血液型入力欄", "趣味入力欄", "好きな物入力欄", "将来の夢入力欄", _

"数字入力欄", "色入力欄", "好きな天候入力欄", "備考欄") '名前定義の一覧。

For APPPP = 1 To 12 '名前定義は12個あるので1〜12。

If InStr(1, Range(ARYY(APPPP - 1)).Value, Chr(10)) > 0 Then 'この単票は改行禁止にしている為 一石二鳥。

PSPS = True

Exit For

End If

Next

Exit Sub '名前定義が無事(かつ未改行)なら、フラグを立てずにSubを抜ける。

DesTroy:

PSPS = True '上のIF文でエラーが発生(名前定義を読み込めない)の場合、ここに飛ぶ。

End Sub

以下はMicrosoft Excel Objectsのコーディングになります。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim SPSF As Boolean

SPSF = False

PSPS = False '初期状態で必ずフラグを降ろす。

If PFlg <> True And FirstFlg <> True Then '起動時と他マクロ実行時は、この処理は行いません。

Call CopyPasteCommandControl(False)

If InStr(1, Cells(Target.Row, Target.Column).Value, Chr(10)) > 0 Then

Cells(Target.Row, Target.Column).Value = Replace(Cells(Target.Row, Target.Column).Value, Chr(10), "")

End If

Call SingleC '名前定義破壊判定(上記参照)

If PSPS = True Then

Else '名前定義が無事だった場合、NumberFormatLocalが正しいか、色がALL255(純白)か、セルの結合が解除されていないか判定。

If Range(MST1).MergeArea.NumberFormatLocal = "@" And Range(MST2).MergeArea.NumberFormatLocal = "@" And _

Range(MST3).MergeArea.NumberFormatLocal = "yyyy/mm/dd" And Range(MST4).MergeArea.NumberFormatLocal = "@" And _

Range(MST5).MergeArea.NumberFormatLocal = "@" And _

Range(MST6).MergeArea.NumberFormatLocal = "@" And Range(MST7).MergeArea.NumberFormatLocal = "@" And _

Range(MST8).MergeArea.NumberFormatLocal = "@" And Range(MST9).MergeArea.NumberFormatLocal = "0" And _

Range(MST10).MergeArea.NumberFormatLocal = "@" And _

Range(MST11).MergeArea.NumberFormatLocal = "@" And Range(MST12).MergeArea.NumberFormatLocal = "@" And _

Range(MST1).MergeArea.Interior.Color = RGB(255, 255, 255) And Range(MST2).MergeArea.Interior.Color = RGB(255, 255, 255) And _

Range(MST3).MergeArea.Interior.Color = RGB(255, 255, 255) And Range(MST4).MergeArea.Interior.Color = RGB(255, 255, 255) And _

Range(MST5).MergeArea.Interior.Color = RGB(255, 255, 255) And Range(MST6).MergeArea.Interior.Color = RGB(255, 255, 255) And _

Range(MST7).MergeArea.Interior.Color = RGB(255, 255, 255) And Range(MST8).MergeArea.Interior.Color = RGB(255, 255, 255) And _

Range(MST9).MergeArea.Interior.Color = RGB(255, 255, 255) And Range(MST10).MergeArea.Interior.Color = RGB(255, 255, 255) And _

Range(MST11).MergeArea.Interior.Color = RGB(255, 255, 255) And Range(MST12).MergeArea.Interior.Color = RGB(255, 255, 255) And _

Range(MST1).MergeArea.Locked = False And Range(MST2).MergeArea.Locked = False And Range(MST3).MergeArea.Locked = False And _

Range(MST4).MergeArea.Locked = False And Range(MST5).MergeArea.Locked = False And Range(MST6).MergeArea.Locked = False And _

Range(MST7).MergeArea.Locked = False And Range(MST8).MergeArea.Locked = False And _

Range(MST9).MergeArea.Locked = False And Range(MST10).MergeArea.Locked = False And Range(MST11).MergeArea.Locked = False And _

Range(MST12).MergeArea.Locked = False And _

Range(MST1).MergeCells And Range(MST2).MergeCells And Range(MST3).MergeCells And Range(MST4).MergeCells And _

Range(MST5).MergeCells And Range(MST6).MergeCells And Range(MST7).MergeCells And Range(MST8).MergeCells And _

Range(MST9).MergeCells And Range(MST10).MergeCells And Range(MST11).MergeCells And Range(MST12).MergeCells Then

Else '上記の内1つでも不正な値が入っていたら、セルが破壊されている証拠になる。

PSPS = True

End If

End If

If PSPS = True Or Application.CutCopyMode = 1 Then 'コピーモードあるいはセル破壊フラグが立っている場合。

PSPS = False 'フラグを戻す。

With Application

.EnableEvents = False

On Error GoTo RR: 'アンドゥ不可能の場合は.Undoは飛ばす。

.Undo '状態を1つ手前に戻す。

RR: 'アンドゥが出来なかった場合はここに飛ぶ。

.EnableEvents = True

On Error GoTo 0 'エラー処理を戻す。

End With

End If

If Application.CutCopyMode = 1 Then 'コピー状態強制解除。

Application.CutCopyMode = 0

End If

Call CopyPasteCommandControl(True)

End If

End Sub

一部の抜粋(個々のSubは未省略)ですが、以上になります。

もし、より良いコーディングがありましたら、ご一報下さい。

●おわりに

最後までお付き合い下さり、ありがとうございました。

質問等、何かありましたら、こちらまで。

時間が余っている時は対応します。