アクティブシートモジュールにコードを挿入する実験 Excel2000 VBA [Excel2000 VBA独習]
アクティブシートモジュールにコードを挿入する実験
Sub シートにコードを挿入()
'「シートイベントで数式の有るセルを選択したら右に移動する」、
'コードをシートモジュールにに追記する
On Error GoTo owari
Dim W_Book As Workbook
Dim book_name, sheet_name As String
'アクティブブック名シート名取得(モジュールを追加する)
book_name = ActiveWorkbook.Name
sheet_name = ActiveSheet.Name
'シートモジュールにコードを挿入
Set W_Book = Workbooks(book_name)
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
owari:
Set W_Book = Nothing
End Sub
2重書き込みかチェックするバージョン
Sub シートにコードを挿入()
'「シートイベントで数式の有るセルを選択したら右に移動する」、
'コードをシートモジュールにに追記する
On Error GoTo owari
Dim W_Book As Workbook
Dim book_name, sheet_name, myProcName As String
Dim i As Long
'アクティブブック名シート名取得(モジュールを追加する)
book_name = ActiveWorkbook.Name
sheet_name = ActiveSheet.Name
'book set
Set W_Book = Workbooks(book_name)
'書き込むプロシージャ名と同じ物があるかチェック
myProcName = "Worksheet_SelectionChange"
With W_Book.VBProject.VBComponents.Item(sheet_name).CodeModule
For i = 1 To .CountOfLines
If myProcName = .ProcOfLine(i, 0) Then GoTo owari
'Debug.Print .ProcOfLine(i, 0)
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
Exit Sub
owari:
Set W_Book = Nothing
MsgBox "既にプロシージャが存在します。"
End Sub
コメント 0