えくせるちゅんちゅん

ことりがエクセルをちゅんちゅんするブログ

VBAで行の挿入を禁止する方法 part1 提案編

今回は「VBAで行の挿入を禁止する方法」について説明します。

本日、Twitterにてこんな呟きがありました。

実はこれ、結構難しいんですよね。

ネットでググってもイマイチな回答しか無く、ベテランのVBAerでも「これ!」って言える手法を確立している人は少ないのではないでしょうか。

そんな中で、私の秘密の扉がいま、開かれます!😅

せっかくなので、ことりちゅんの秘奥義2ってことにしときましょう。😝


挿入を防止する方法

大きくわけて2つのアプローチがあると考えられます。

  1. SelectionChangeイベントで挿入コマンドを使えないようにする。
  2. Changeイベントで挿入を検知してから、元に戻すなどで操作を無かったことにする。

本命は2なのですが、それだけではちょっと寂しいので、余興のために1を作ってみました。

怒らないで読んでね❤

(余興)挿入コマンドを使えないようにする。

無効化する方法もあると思うのですが、私のやったことのある「挿入コマンドを消す方法」を少しだけご紹介。

まず、Excel標準のコマンドはCommandBarsコレクションを操作することで対応できます。

詳しく知りたい人はOffice 2016 コントロールID リストなんかでググるとちょっとだけ幸せになれるかも?

ソースコード

こちらが5行目を選択した時だけコンテキストメニューから「挿入(&I)」が消えるコードです。

※上手くいかない場面があるため、デバッグ用コードを全て残しています。

下記のコードはSheetモジュールに貼ってください。

'5行目を選択した時だけ「挿入」コマンドを消すコード
Private Declare Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Columns.Count = Me.Columns.Count And _
       Target.CountLarge Mod Me.Columns.Count = 0 And _
       Target.Row = 5 Then
        Debug.Print "SC Delete"
        Call DeleteMenu_挿入コマンド
        '5行目をいきなり右クリックで表示すると、
        'なぜかApplication.CommandBars("Row")配下に
        '挿入(&I)が存在せず、削除することが出来ない現象が起こる。
        '下記のようにスリープを入れたりDoEventsを入れたが解決せず
        DoEvents
        Sleep 100 'Application.Wait [Now() + "00:00:00.1"]
        DoEvents
    Else
        Debug.Print "SC Reset"
        Call ResetMenu_挿入コマンド
    End If
End Sub

Sub DeleteMenu_挿入コマンド()
    Dim Bar As CommandBar
    Dim Ctrl As CommandBarControl
    Dim CmdFind As Boolean
    For Each Bar In Application.CommandBars
        If Bar.Name = "Row" Then
            Debug.Print Bar.ID
            For Each Ctrl In Bar.Controls
                If Ctrl.Caption = "挿入(&I)" Then
                    Ctrl.Delete
                    Debug.Print "Deleted"
                    CmdFind = True
                Else
                    'Debug.Print Ctrl.Caption
                End If
            Next
        End If
    Next
    If Not CmdFind Then Debug.Print "Not Deleted"
End Sub

Sub ResetMenu_挿入コマンド()
    Dim Bar As CommandBar
    Dim Ctrl As CommandBarControl
    For Each Bar In Application.CommandBars
        If Bar.Name = "Row" Then
            Bar.Reset 'Resetしても一度メニューを出すまでは更新されないぽ
        End If
    Next
End Sub

ダメな点

使えないコードなので、細かい解説は省きます。ggrks

まず、正常時のイミディエイトウィンドウがどのように表示されるか書いておきます。

 SC Reset ・・・ 適当なセルを選択
 SC Delete ・・・ 5行目を右クリック
 425 
Deleted
 428 
 3029 

コントロールID:425の時点で削除が実行されています。

それでは問題点を順番にみていきまっしょー

1.セルを選択した状態から、5行目を右クリックすると挿入が消えません。

上記の通り、試行錯誤を重ねたのですが、実行するとこのようになります。

 SC Reset ・・・ 適当なセルを選択
 SC Delete ・・・ 5行目を右クリック
 425 
 428 
 3029 
Not Deleted

'Debug.Print Ctrl.Captionのコメントを外していただくと分かるのですが、どうやらメニューの内容の書き換えが追いついてないみたいで、セル選択時と同じ物が出るようです。

A5を選択>Shift+Spaceで行選択>コンテキストメニュー表示もNGです。

ちなみに適当な行選択状態から、5行目を右クリックした場合はOKです。

2.行の挿入そのものは無効化されません。

つまり、セル選択状態に「挿入」コマンドを実行して、「行の挿入(&R)」を選んだり、リボンの「セル」>「挿入」>「シートの行を挿入(&R)」を実行すれば挿入はできます。

ちょっと微妙ですね・・・。

解決策を知ってる人いたら教えてくださいな。

(本命)挿入を検知して元に戻す。

もう一つがChangeイベントで行の挿入を検知してから、元に戻すで操作を無かったことにする方法です。

この「行の挿入を検知する」コードがVBAにおける難関の一つ(当社比)とされてまして、ネット上の質問サイトではよく迷宮入り、あるいは仕方なく解決していたような気がします。

そこで私が提案するのが、「挿入直前のRangeオブジェクトのインスタンスを捕まえておく方法」です。

クイズ1

突然ですが問題です。以下のコードは何が出力されるか分かりますか?

Sub テスト()
    Dim rng As Range
    Set rng = Range("A2")
    Cells.Rows(2).Insert xlDown
    Debug.Print rng.Address
End Sub

まずSet rng = Range("A2")というのが何をしているかというと、セルA2のインスタンスへのメモリアドレスをrngに格納しています。

ここ超重要です。テストに出ます。

そして、Cells.Rows(2).Insert xlDown1行分の新しいインスタンスを生成し2行目に挿入します。

つまり(EXCELのコレクション的に見て)2行目以降のインスタンスは1行下にシフトされるわけですね。

さらに言えば最終行の1048576行目のインスタンスは破棄されているはずです。

データが入っていると、データが消失するため挿入できません!ってエラーが出るんですけどね。

解説に自信がないので違ったらごめんね♪

従ってrng.Addressの答えは$A$3になります。

クイズ2

第二問です。

Sub クイズ2()
    Dim rng As Range
    Set rng = Range("A5")
    Cells.Rows(2).Delete xlUp
    Debug.Print rng.Address
End Sub

いや、もう分かったからいいわ・・・って人も一応お付き合いください。

一応解説するとCells.Rows(2).Delete xlUp2行目のインスタンスを破棄して上に詰める命令です。

つまり(EXCELのコレクション的に見て)3行目以降のインスタンスが1行上にシフトされるわけですね。

さらに言えば最終行の1048576行目に新しいインスタンスが生成されているはずです。

従ってrng.Addressの答えは$A$4になります。

しかし以下の様な場合には注意が必要です。

Sub クイズ2危険()
    Dim rng As Range
    Set rng = Range("A2")
    Cells.Rows(2).Delete xlUp
    Debug.Print rng.Address
End Sub

rngのメモリアドレスの示す先のインスタンスが消えてしまいました。

これを実行すると、rng.Addressの部分で下記のエラーが出ます。

実行時エラー 424
オブジェクトが必要です。

こうなったら最後、rngのプロパティには一切アクセスできなくなります。

アクセス出来ないと言っても、rngが空になっているわけではなくて、

?rng is nothing

を実行しても

False

となるため、破壊されていることを確認する術がありません。

従って止む無くOn Error GoTo BrokenSkipなんてことをして逃げています。

適切な確認方法を知ってる人いたらマジで教えてください。

ソースコード

以上を踏まえて書き起こしたコードはこちらになります。

'5行目への挿入、コピー挿入を禁止するコード
Option Explicit

Private rngA5Cache As Range

'セル選択時にRange("A5")の示すインスタンスを捕まえておく
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set rngA5Cache = Me.Range("A5")
End Sub

'滅多にないがセル選択済みのまま保存した場合の対策
'ブック(シート)を開いた時にRange("A5")の示すインスタンスを捕まえておく
Private Sub Worksheet_Activate()
    Set rngA5Cache = Me.Range("A5")
End Sub

'セル変更時の処理
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not rngA5Cache Is Nothing Then
        If Target.Columns.Count = Me.Columns.Count And _
            Target.CountLarge Mod Me.Columns.Count = 0 And _
            Target.Row = 5 Then

            '削除直後はrngA5Cacheの場合オブジェクトが崩壊している。
            '崩壊したことを上手く確認する方法がわからない。
            On Error GoTo BrokenSkip
            Debug.Print rngA5Cache.Address & " : " & Me.Range("A5").Address
            On Error GoTo 0

            If rngA5Cache.Address <> Me.Range("A5").Address Then
                '行の挿入前に戻す
                Application.EnableEvents = False
                Application.Undo
                Application.EnableEvents = True
            End If
BrokenSkip:
        End If
    End If
End Sub

解説

重要なことはもう話してしまいました。

やっていることは次のような流れです。

(1) 何らかのセルを選択した時、またはシートがアクティブになった時、Range("A5")の示すインスタンスrngA5Cacheに保存しておく。

Private rngA5Cache As Range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set rngA5Cache = Me.Range("A5")
End Sub

Private Sub Worksheet_Activate()
    Set rngA5Cache = Me.Range("A5")
End Sub

(2) シート上のセルの変更を検知する

Private Sub Worksheet_Change(ByVal Target As Range)

(3) キャッシュされていることを確認

If Not rngA5Cache Is Nothing Then

(4) 変更されたセルが5行目(から開始する複数行)であることを確認

If Target.Columns.Count = Me.Columns.Count And _
    Target.CountLarge Mod Me.Columns.Count = 0 And _
    Target.Row = 5 Then

ここが少し難しそうなので解説します。

Target.Columns.Count = Me.Columns.Count

まずこれは、対象セルの列数=シート全体のセルの列数を比較しています。

今どきのエクセルならA~XFD。つまり16384列です。

要するに行全体が対象か?を判断しているわけですね。

Target.CountLarge Mod Me.Columns.Count = 0

次にこれは、対象セルの総数がシート全体のセルの列数で割り切れるかどうかを確認しています。

どんなパターンを想定しているかと言うと、対象が複数行ある可能性を考慮しています。

もし1行しか想定しない場合は上記2つの式の代わりに、Target.CountLarge = Me.Columns.Countで良いと思います。

Target.Row = 5 Then

さすがにこれは説明不要か。対象セルの行が5行目かを見ているだけです。

5行目以前の挿入をまとめて禁止したい場合は消しちゃった方が良いかもです。

(5) キャッシュが破壊済みセルである場合に回避

On Error GoTo BrokenSkip
Debug.Print rngA5Cache.Address & " : " & Me.Range("A5").Address
On Error GoTo 0
'・・・
BrokenSkip:

先に説明した通りの問題です。

具体的には5行目を削除した時にエラーが発生するので、その回避策です。

もし行の削除を禁止したい場合は、エラートラップ時にUndoを実行すれば良いということになります。

(6) 変更前のA5と現在のA5のアドレスを比較

If rngA5Cache.Address <> Me.Range("A5").Address Then

これで一致しなかったら、行の挿入または削除が発生したということを確認できます。

(7) 元に戻すを実行

Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True

「元に戻す」コマンドを実行します。

単純に実行するだけだとUndoメソッドでChangeイベントが発生して無限ループになりかねないので、イベントの発生を無効化してから元に戻しています。

Target.EntireRow.Deleteでも消すことは出来ますが、この方法のメリットは「元に戻す」コマンドが壊れないという点でしょう。

ご存知の方が大半だと思いますが、VBAを使ってセルの書き換えを行うと元に戻すが使えなくなるんですよね。

Undoならそのような問題は起こりませんので、ユーザーに優しいシステムになります。

対応していないこと

上記の例ではいくつか考慮していない点があります。

  1. 行以外の範囲指定(A5:Z5等の範囲指定など)で挿入した場合は挿入できる。
  2. 表のヘッダより上(1~4行目)が挿入・削除される危険性がある場合には対応していない。

基本的にはシートの保護と連携して1~4行目を編集禁止としておく場合に使いますので、保護しておけば2は問題とはならないと思います。

まとめ

というわけで、行の挿入を禁止する方法でした。

2019/1/8 続編書きました♪

www.excel-chunchun.com

以上


何か御座いましたらコメント欄、またはTwitterからどうぞ♪

それではまた来週♪ ちゅんちゅん(・8・)