Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


24028 / 76732 ←次へ | 前へ→

【58059】特定のシートのみ行列の挿入削除を制御したい
質問  ON  - 08/9/30(火) 16:00 -

引用なし
パスワード
   こんにちは よろしくお願い致します


やりたいことは、
特定のシートのみ行列の挿入削除を制御したいです
通常は禁止、挿入削除したい場合はメニュバーに追加した独自メニュから
実施したいと思っています
判定は、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
0 hits

【58059】特定のシートのみ行列の挿入削除を制御したい ON 08/9/30(火) 16:00 質問
【58060】Re:特定のシートのみ行列の挿入削除を制御... ON 08/9/30(火) 16:11 質問

24028 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free