| |
こんにちは よろしくお願い致します
やりたいことは、
特定のシートのみ行列の挿入削除を制御したいです
通常は禁止、挿入削除したい場合はメニュバーに追加した独自メニュから
実施したいと思っています
判定は、c3の値が 制御シート の時です
後、同一プロセスの他のブックには影響させない
シートの保護での方法もあるかなと思ったのですが
組合せがうまく出来ずにvbaのほうが楽な気がしましたが
どうも、他でコピーモードだったり、クリップボードに値があると
シート上で右クリックからのポップアップメニューでは
行挿入がグレーアウトにならないような状況があったりするようです
なぜうまくいかないか色々テストしたのですがわかりませんでした
後、一般機能 シート保護での方法もご教授頂けると助かります
アドバイスよろしくお願い致します
／標準モジュール／／／／／／／／／／／／／／／／／／／／／／／／／／／／／／／／／／／
'行挿入削除 禁止
Sub unEnabled_set()
Dim ct As Object
Dim ct1 As Object
Application.ScreenUpdating = False
Application.CutCopyMode = False
For Each ct In CommandBars("Worksheet menu bar").Controls 'メニューバー／編集／削除 グレー表示セット
'Debug.Print ct.Caption
If ct.Caption = "編集(&E)" Then
For Each ct1 In ct.Controls
'Debug.Print ct1.Caption
If ct1.Caption = "削除(&D)..." Then
'Debug.Print ct1.Caption & "Enabled"
ct1.Enabled = False 'False
End If
Next
'追加
ElseIf ct.Caption = "挿入(&I)" Then
For Each ct1 In ct.Controls
'Debug.Print ct1.Caption
If ct1.Caption = "セル(&E)" Then
'Debug.Print ct1.Caption & "Enabled"
ct1.Enabled = False 'False
ElseIf ct1.Caption = "行(&R)" Then
'Debug.Print ct1.Caption & "Enabled"
ct1.Enabled = False 'False
ElseIf ct1.Caption = "列(&C)" Then
'Debug.Print ct1.Caption & "Enabled"
ct1.Enabled = False 'False
End If
Next
End If
'DoEvents
Next
'DoEvents
ActiveSheet.Range("A3").Select 'セル範囲選択時の削除 グレー表示セット
For Each ct In CommandBars("cell").Controls
Debug.Print ct.Caption
If ct.Caption = "挿入(&I)..." Then
'Debug.Print ct.Caption & "Enabled"
ct.Enabled = False 'False
ElseIf ct.Caption = "削除(&D)..." Then
ct.Enabled = False 'False
End If
'DoEvents
Next
'DoEvents
ActiveSheet.Rows(2).Select '行選択時の削除 グレー表示セット
For Each ct In CommandBars("Row").Controls
Debug.Print ct.Caption
If ct.Caption = "挿入(&I)" Then '列範囲選択時
'Debug.Print ct.Caption & "Enabled"
ct.Enabled = False 'False
ElseIf ct.Caption = "削除(&D)" Then
ct.Enabled = False 'False
End If
'DoEvents
Next
'DoEvents
ActiveSheet.Columns(2).Select '列選択時の削除 グレー表示セット
For Each ct In CommandBars("Column").Controls
'Debug.Print ct.Caption
If ct.Caption = "挿入(&I)" Then '列範囲選択時
'Debug.Print ct.Caption & "Enabled"
ct.Enabled = False 'False
ElseIf ct.Caption = "削除(&D)" Then
ct.Enabled = False 'False
End If
'DoEvents
Next
'DoEvents
'ActiveSheet.cell(1, 1).Select
ActiveSheet.Range("A1").Select
Application.ScreenUpdating = True
End Sub
'行挿入削除 可
Sub Enabled_set()
Dim ct As Object
Dim ct1 As Object
Application.ScreenUpdating = False
Application.CommandBars("Worksheet menu bar").Reset
Application.CommandBars("cell").Reset
Application.CommandBars("Row").Reset
Application.CommandBars("Column").Reset
Application.ScreenUpdating = True
End Sub
／ThisWorkbookモジュール／／／／／／／／／／／／／／／／／／／／／／／／／／／／／／／／／／／
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'MsgBox Sh.Cells(1, 3).Value
If Sh.Cells(1, 3).Value = "制御シート" Then
'Call AddControl
'DoEvents
Call unEnabled_set
'DoEvents
Else
Call Enabled_set
End If
End Sub
Private Sub Workbook_Activate()
'MsgBox Sh.Cells(1, 3).Value
If ActiveSheet.Cells(1, 3).Value = "制御シート" Then
'Call AddControl
'DoEvents
Call del_unEnabled_set
'DoEvents
Else
Call Enabled_set
End If
End Sub
Private Sub Workbook_WindowDeactivate(ByVal Wn As Window)
Call Enabled_set
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
