シートの数式を保護（選択出来ないようにする）コードをシートに追記するマクロ Excel2000 VBA

シートの数式を保護（選択出来ないようにする）コードをシートに追記するマクロの実験

マクロを実行すると、シートモジュールにシートイベントのコードを追記して数式が設定されているセルを選択すると右に移動する。
コードが存在していればコードの追記は行わない。

最初にワークシートイベントを有効、無効にするマクロ作成する。（無効にしてシートの数式編集など、有効にして入力作業）

Sub シートイベント有効無効()
’実行する度に有効→無効→有効→
If Application.EnableEvents = False Then Application.EnableEvents = True Else Application.EnableEvents = False
End Sub

シートにコード追記するマクロ（実験段階）

Sub シートの数式を選択出来ないようにする()
'「シートイベントで数式の有るセルを選択したら右に移動する」、
'コードをシートモジュールにに追記する
'On Error GoTo owari
  Dim W_Book  As Workbook
  Dim book_name, sheet_name, myProcName As String
  Dim i, end_line As Long
'アクティブブック名シート名取得（モジュールを追加する）
    book_name = ActiveWorkbook.Name
    sheet_name = ActiveSheet.Name
'book set
    Set W_Book = Workbooks(book_name)
   
'書き込むプロシージャ名と同じ名があるかチェック
  
    myProcName = "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
   
    With W_Book.VBProject.VBComponents.Item(sheet_name).CodeModule
        'end_line = .CountOfLines
        For i = 1 To .CountOfLines
        'Debug.Print .Lines(i, 1)
            If myProcName = .Lines(i, 1) Then GoTo owari
            'Debug.Print .Lines(i, 1) '1行ずつコード
        Next i
    End With
   
'挿入書き込み
  With W_Book.VBProject.VBComponents.Item(sheet_name).CodeModule
          .insertlines 2, "Private Sub Worksheet_SelectionChange(ByVal Target As Range)"
          .insertlines 3, "If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select"
          .insertlines 4, "End Sub"
  End With
  Set W_Book = Nothing
  MsgBox "シートの数式保護（選択不可）完了"
  Exit Sub
owari:
    Set W_Book = Nothing
    MsgBox "既にプロシージャが存在します。"
End Sub

 

タグ：Excel2000 VBA