ＶＢＡでエクセルのワークシートに、列と行の、挿入と削除を禁止したい

質問

お忙しいところ、私の質問に取り組んで頂き、有難うございます。

ＶＢＡを使って、エクセルのワークシートを編集中に、指定しておいた範囲に、列と行を挿入しようとすると、禁止のメッセージが出て、それらの操作ができないように制御したいのですが、ネット検索をしても、どうしても良い方法が見つかりませんでした。どなたか、良い案のある方、ご教示願えないでしょうか？

回答No.2

N64

ユーザによっては、禁じられたレンジを、範囲選択したりすることもあるでしょう。その場合は、禁じられたレンジの中のすべてのレンジについて、ユーザの選択範囲に入っているかを、調べればすみます。そのコードを追加したものは以下のとおりです。

Option Explicit
Private WithEvents mySheet As Excel.Worksheet
Private Sub mySheet_SelectionChange(ByVal Target As Range)
Dim myRange As Excel.Range
Dim myRowTop As Long, myRowBottom As Long
Dim myColLeft As Long, myColRight As Long
Dim I As Long, J As Long
Dim Jump As Boolean
Set myRange = mySheet.Range("D8:F11")
myRowTop = myRange.Row
myRowBottom = myRowTop + myRange.Rows.Count - 1
myColLeft = myRange.Column
myColRight = myColLeft + myRange.Columns.Count - 1
If Target.Row >= myRowTop And Target.Row <= myRowBottom Then
If Target.Column >= myColLeft And Target.Column <= myColRight Then
MsgBox "ダメヨ！"
mySheet.Range("A1").Select
Else
GoSub MySub1
End If
Else
GoSub MySub1
End If
Exit Sub
MySub1:
For I = myRowTop To myRowBottom
For J = myColLeft To myColRight
If I >= Target.Row And I <= Target.Row + Target.Rows.Count - 1 Then
If J >= Target.Column And J <= Target.Column + Target.Columns.Count - 1 Then
MsgBox "だめだめ!!"
mySheet.Range("A1").Select
Jump = True
Exit For
End If
End If
Next J
If Jump = True Then Exit For
Next I
Return
End Sub
Private Sub Workbook_Open()
Set mySheet = ActiveSheet
End Sub

お礼

最初の回答を下さった方と同じ方と推察致します。
追加のコードまで頂き、感無量です！！
早速、コードを試してみました。私が意図しているもの
は確実に実現できていました！・・・が！！
私の実力不足のため、２つほど解決したいことが
できかねていますので、ご相談に乗って頂けませんでしょうか？

このコードを実行すると、例えば、”Ｄ８”だけを選択
し、値を入力しようとするだけでも、”ダメヨ！”と
出てしまいます。これを避ける方法が未熟な私には解りません。

また、例えば、”Ｄ８：Ｄ１０”の範囲を選択し、コピー
しようとすると、”だめだめ！！”と出てしまいます。
これも回避したいのですが、無理でしょうか？

私の意図した、例えば、”Ｄ列全体”を選択して挿入しようと
したときに、”だめだめ！！”と出るのは凄くうれしかった
です＾＾　無理だと思っていたのもで。

お忙しいところを大変申し訳なく思いますが、お時間あらば
なんとかご相談に乗ってくださいませ。
宜しくお願い致します。

回答No.1

N64

その範囲を、仮に、D8:F11,とすると、以下のようなマクロをThisWorkBook に組み込めば、ひとまずは、よいでしょう。

Option Explicit
Private WithEvents mySheet As Excel.Worksheet
Private Sub mySheet_SelectionChange(ByVal Target As Range)
Dim myRange As Excel.Range
Dim myRowTop As Long, myRowBottom As Long
Dim myColLeft As Long, myColRight As Long
Set myRange = mySheet.Range("D8:F11")
myRowTop = myRange.Row
myRowBottom = myRowTop + myRange.Rows.Count - 1
myColLeft = myRange.Column
myColRight = myColLeft + myRange.Columns.Count - 1
If Target.Row >= myRowTop And Target.Row <= myRowBottom Then
If Target.Column >= myColLeft And Target.Column <= myColRight Then
MsgBox "ダメヨ！"
mySheet.Range("A1").Select
End If
End If
End Sub
Private Sub Workbook_Open(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Set mySheet = ActiveSheet
End Sub

お礼

お礼が遅くなり、すみませんでした
全く素晴らしいの一言につきます！
このコードを少しづつ解析してみましたが
今の私では全てを解読できません＾＾；
追加のコードを書いて頂いた方も同じ方と
思いますので、そちらに、追加質問を
させて頂きます。・・・が違う方でしたら
いけませんので、一応、きちんとお礼を
述べたかったです。お忙しいところ
有難うございました。