『EXCEL VBA 行追加 禁止マクロ  』（あやころ）

EXCEL VBA 行追加 禁止マクロ 

VBA初心者です。

EXCEL VBAを利用して、
名前の定義された範囲への行の追加禁止のVBAを組みたいです。たとえばA1:G50の範囲に”売上”という名前を定義しているとすると、
その”売上”のセル範囲への行追加を禁止したいです。

ネットにて、先頭行追加禁止の構文は見つけたのですが、
これら構文を、どのように変更すべきかお教え頂けないでしょうか？

よろしくお願いいたします。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim m_Address As String, m_BeforeRange As Range
If Target.Item(1).Row = 1 Then
m_Address = Target.Address
With Application
.EnableEvents = False
.Undo
Set m_BeforeRange = Me.Range(m_Address).Item(1)
.Repeat
If m_BeforeRange.Row <> Me.Range(m_Address).Item(1).Row Then
Me.Range(m_Address).Delete
MsgBox "1行目への挿入は禁止されています。", vbExclamation
End If
.EnableEvents = True
End With
End If
End Sub



＜ 使用 Excel：Excel2007、使用 OS：Windows7 ＞
----
 何故に特定の範囲だけ禁止したいのですか？
 マクロということは、無効で開かれたときは禁止できないわけですよね？

 考え方としてはシートを保護して、必要な範囲をVBAで行追加させるというのが
 プログラムとして自然な流れだと思います。

 最初の質問に戻りますが、何故禁止したいのかを説明いただければ、他の解答も
 できるのではないかと思います。

 
（稲葉） 2015/08/27(木) 08:38
----
 ID非公開さん、こんにちは。

 回答者への参考です。

http://detail.chiebukuro.yahoo.co.jp/qa/question_detail/q14149248104?__ysp=RXhjZWwgVkJB6LOq5ZWP566xIElWIOmWsuimpyDkuI3lj68%3D
（マルチネス） 2015/08/27(木) 08:55
----
 素朴な疑問なんですが、A1:G50 の領域内のいくつかのセルを選択して、セル挿入操作を行うのはＯＫなんですか？

（β） 2015/08/27(木) 09:02
----
 追加です。

 "売上"という領域の行を増やしたくない（減らすのはいい？）ということならわかるのですが
 １行目に挿入するということは、売上という領域は１行、下に移動しますが、領域内の構成は変更ないわけですよね。
 それを禁止するという目的がちょっとわからないです。

 こちらがわからないだけで、ちゃんとした目的があるとすれば、変更前の状態の"売上"領域の先頭行が
 変更後の先頭行と同じであり、変更前の行数と変更後の行数も同じというチェックをかければいいとは思いますが。

 ところで、列は挿入しても削除してもいいのですか？

（β） 2015/08/27(木) 09:58
----
 A1:G50のセル範囲を「売上」という名前で定義と聞くと
 区分　コード　品名　数量　単位　単価　金額

 又は、

 コード　品名　数量　単位　単価　金額　備考

 なんて列を想像をしてしまいますが・・・。

 いずれにせよ　Excelは色んな事が出来るので逆に制限したい場合は気を使いますよね！！


 売上　という名前の定義をされているセル囲は、行挿入や削除　列挿入や削除によって、
 
 定義セル範囲が変わります。この性質を利用することを検討してみてください。

 
 

　
（ichinose） 2015/08/29(土) 20:56
----
 売上　という領域がどういうものなのか、その領域に対して、どのような変更を禁止したいのかが不明ですが
 （β） 2015/08/27(木) 09:02 で、つぶやいたことが気になります。

 新規ブックに以下を貼り付けて、実行してみて下さい。こういう変更はＯＫなんでしょうかね？

 Sub これはいいのですか()
    Dim oldAddr As String
    
    Cells.Clear
    Cells.Interior.ColorIndex = xlNone
    
    With Range("B4:D9")
        .Value = "売上"
        .Interior.Color = vbYellow
        ThisWorkbook.Names.Add Name:="売上", RefersTo:="=" & .Address
        oldAddr = Range("売上").Address
        
        MsgBox "領域を確認してください" & vbLf & "今から領域内のセルを基準に挿入します"
        Range("C5").Insert Shift:=xlDown
        
    End With
    
    MsgBox "領域 売上のアドレス" & vbLf & "挿入前:" & oldAddr & vbLf & "挿入後:" & Range("売上").Address & vbLf & "同じなんですが、いいのでしょうか？"
    
 End Sub

（β） 2015/08/29(土) 22:37
----
 個別のセルの挿入操作もあるなら、名前の定義を以下のようにするお方法でも
 行けると思います


 Sub mk_name()
    Dim rng As Range
    Dim g0 As Long
    Set rng = Range("a1:g50")
    For g0 = 1 To rng.Rows.Count
        With rng.Rows(g0)
           .Name = "uri_" & Split(.EntireRow.Address(False, False), ":")(0)
        End With
    Next
    For g0 = 1 To rng.Columns.Count
        With rng.Columns(g0)
           .Name = "uri_" & Split(.EntireColumn.Address(False, False), ":")(0)
        End With
    Next
 End Sub



（ichinose） 2015/08/30(日) 19:58
----
 売上　という領域の場所は移動してもいいけど、その大きさ、その構成セル群は変更禁止ということなら
 少し長くなりますが。コードを整理すれば、もう少し、スッキリできるかもしれません。

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim w As Variant
    Dim er As Boolean
    Dim x As Long
    Dim y As Long
    Dim z As Long
    Dim c As Range
    Dim r As Range
    Dim sv As String
    Dim tAddr As String
    sv = ActiveCell.Address
    tAddr = Target.Address
    
    On Error Resume Next
    Set r = Range("売上")
    On Error GoTo 0
    
    If r Is Nothing Then
        MsgBox "この変更操作はできません"
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
        Exit Sub
    End If
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Undo
    
    If Intersect(Range(tAddr), Range("売上")) Is Nothing Then
        Application.Undo
        Application.EnableEvents = True
        Exit Sub
    End If
    
    With Range("売上")
        x = .Columns.Count
        y = .Rows.Count
        ReDim w(1 To x * y)
        For Each c In .Cells
            z = z + 1
            Set w(z) = c
        Next
    End With
    
    Application.Undo
    
    With Range("売上")
        If x <> .Columns.Count Or y <> .Rows.Count Then
            er = True
        Else
            For z = 1 To .Cells.Count
                Set c = Nothing
                On Error Resume Next
                Set c = Intersect(Range("売上"), w(z))
                On Error GoTo 0
                If c Is Nothing Then
                    er = True
                End If
                
                If er Then Exit For
                
            Next
        End If
        
        If er Then
            MsgBox "この変更操作はできません"
            Application.Undo
        Else
            Range(sv).Select
        End If
    End With
    
    Application.EnableEvents = True
    
 End Sub


（β） 2015/08/30(日) 21:43
----
 ↑　アップしたとたんに欠陥発見。

 領域の左側、あるいは上方のセルを選択して挿入、削除を行うと、エラーにはひっかからず、領域のセル構成が
 変更前とは異なるものになってしまいますね。

 （つまり、変更前は領域に加わっていなかったセルが領域内に入る、あるいは変更後、領域内のセルが外に飛び出す）

 ichinoseさんご提示のセル毎の名前にしておけば、各構成セルが変更後も領域内に残っているというチェックでいけそうですね。


（β） 2015/08/30(日) 21:48
----
 領域外のセルを起点にして挿入を行ったときに、領域内のセルが、その領域を飛び出してしまうケースもチェック。
 ただ、このシート上の、どの場所のどんな変更時もチェックが動いてしまうので（結果はからぶりですが）ちょっと、情けないですが。

 以下の準備を実行してください（一回だけでＯＫ）
 ichinoseさんが提示された領域内各セルに名前を付けます。("売上" という領域の各セルに 売上_1、売上_2、・・・）

 Sub 準備()
    Dim nm As Name
    Dim x As Long
    Dim c As Range
    
    For Each nm In ActiveWorkbook.Names
        If nm.Name Like "売上_*" Then nm.Delete
    Next
    
    For Each c In Range("売上")
        x = x + 1
        c.Name = "売上_" & x
    Next
    
 End Sub


 で、本番コード。シートモジュールに。

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim er As Boolean
    Dim x As Long
    Dim y As Long
    Dim z As Long
    Dim r As Range
    Dim sv As String
    Dim tAddr As String
    Dim ck As Range
    
    sv = ActiveCell.Address
    tAddr = Target.Address

    On Error Resume Next
    Set r = Range("売上")
    On Error GoTo 0

    If r Is Nothing Then
        MsgBox "この変更操作はできません"
        Application.EnableEvents = False
        Application.Undo
        Application.EnableEvents = True
        Exit Sub
    End If

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Undo

    With Range("売上")
        x = .Columns.Count
        y = .Rows.Count
    End With

    Application.Undo

    With Range("売上")
        If x <> .Columns.Count Or y <> .Rows.Count Then
            er = True
        Else
            For z = 1 To x * y
                Set ck = Nothing
                On Error Resume Next
                Set ck = Intersect(.Cells, Range("売上_" & z))
                On Error GoTo 0
                If ck Is Nothing Then
                    er = True
                    Exit For
                End If
            Next
        End If
        
        If er Then
            MsgBox "この変更操作はできません"
            Application.Undo
        Else
            Range(sv).Select
        End If
    End With

    Application.EnableEvents = True

 End Sub

（β） 2015/08/31(月) 17:29
----
急な不幸事があったため、返信が遅れてしまいました。
稲葉様、マルチネス様、
β様、ichinose様、ありがとうございます。

（β） 2015/08/31(月) 17:29で書かれているコードがまさに私のやりたい事でした。

このコードをこのままコピーして使用したところ、"この変更操作はできません"の
メッセージボックスをOKをクリックして消した後、エクセル自体がフリーズしてし
まって、しばらく動かなくなります。
どうしたら動く様になるでしょうか？
PCのスペックの問題でしょうか？
教えてください。
（あやころ） 2015/09/04(金) 14:15
----
 >>（β） 2015/08/31(月) 17:29で書かれているコードがまさに私のやりたい事でした。 

 ん？
 フリーズして動かないのに、確認できたのですか？
 それともテストブックでは動いたけど、本番ブックではフリーズ？

 実際の　"売上" という名前が付けられている領域（セルアドレス）を教えてください。

（β） 2015/09/04(金) 14:27
----
フリーズしたので、タスクの終了でExcelを強制終了させようとしました。
すると、「ブックを保存しますか？」のメッセージが出たので、
キャンセルをクリックすると、元通りにExcel編集できるようになっていました。
その時にデータ見たら、セルの挿入がされてなかったので、確認出来たと思っていました。

実際の”売上”の領域はA31:AI58です。

範囲が広すぎるせいでしょうか？

（あやころ） 2015/09/05(土) 08:02
----
 同じ環境をつくって、何パターンかやってみましたが、こちらではフリーズしません。
 (win7+xl2010、win8.1+xl2013)  win7+xl2007　は環境がないので確認できませんが。

 ただ、この２つの環境ともに不思議な現象が。

 小さな領域（縦４行、横３列程度）の場合、範囲外の上のほうの行を選択して行挿入。
 これは領域いの構成が変わることはなく移動するだけなので許しているんですが、
 これをA31:AI58の大きな領域で行うと、その操作はできません　となってしまいます。

 フリーズはしませんが、領域の大きさにより、何かが違うんでしょうね。

 しかし、いずれにしても、そちらの環境で、フリーズするなら、このアイデアは使えませんねぇ。

（β） 2015/09/05(土) 09:14
----
あれから、色々自分なりに試行錯誤してみました。


 

（β） 2015/08/31(月) 17:29に書かれているコードの途中で

Application.ScreenUpdating = True

を下記のようにいれることで、動くようになりました。


 

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim er As Boolean

    Dim x As Long

    Dim y As Long

    Dim z As Long

    Dim r As Range

    Dim sv As String

    Dim tAddr As String

    Dim ck As Range


 


 

    sv = ActiveCell.Address

    tAddr = Target.Address


 


 

    On Error Resume Next

    Set r = Range("売上")

    On Error GoTo 0


 


 

    If r Is Nothing Then

        MsgBox "この変更操作はできません"

        Application.EnableEvents = False

        Application.Undo

        Application.EnableEvents = True

        Exit Sub

    End If


 


 

    Application.EnableEvents = False

    Application.ScreenUpdating = False

    Application.Calculation = xlCalculationManual

    Application.Undo


 


 

    With Range("売上")

        x = .Columns.Count

        y = .Rows.Count

    End With


 


 

    Application.Undo

Application.ScreenUpdating = True


 


 

    With Range("売上")

        If x <> .Columns.Count Or y <> .Rows.Count Then

            er = True

        Else

            For z = 1 To x * y

                Set ck = Nothing

                On Error Resume Next

                Set ck = Intersect(.Cells, Range("売上_" & z))

                On Error GoTo 0

                If ck Is Nothing Then

                    er = True

                    Exit For

                End If

                DoEvents

            Next

       End If

Application.ScreenUpdating = True


 


 

        If er Then

            MsgBox "この変更操作はできません"

            Application.Undo

        Else

            Range(sv).Select

        End If

    End With


 


 

    Application.EnableEvents = True

   

 Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True


 

End Sub


 

（β）さん、本当にありがとうございました。


 

ちなみにこちらのPCでは（β） 2015/09/05(土) 09:14に書かれてる現象は起こりませんでした。


 

エクセルのバージョンでなにかが違うのでしょうね・・・
（あやころ） 2015/09/10(木) 18:17
----
 >>Application.ScreenUpdating = True

 あぁ、そういうことだったのかもしれませんね。
 もし、そうであれば、ここは DoEvents でもいいかも。

 かつ（おそらく）必要な場所は、最初のApplication.ScreenUpdating = True　だけかもしれません。

 Application.Undo が指示されて、でも、（メモリーの状態によっては）それが完全に機能して、元に戻る前に　Range("売上") が参照される。 
 ここで、メモリーが固まってしまう。そんなことなのかもしれませんね。

 勉強になりました。

 

（β） 2015/09/11(金) 00:08