6

全て、

Excel マクロの一部の VBA コードでエラーが発生しています。私が試みているワークフローは次のとおりです。

  • コードを実行して新しいワークシートを作成し、フォーマットして、一連の値を追加するモジュールがあります
  • この同じモジュール内で、入力された最後の行に基づいてセルの範囲を決定します (前のステップによって常に異なります)。

  • この範囲がわかったら、以下のコードを使用して、新しく作成したワークシート コード モジュールに書き込み、「change_event」を設定できるようにします。決定したばかりの範囲内の値が変更された場合にのみ、change_event をトリガーしたい:`

    Dim Startline As Long
Startline = 1
Dim x As Integer
x = Errors.Count - 1

Dim rng As Range
Set rng = Range("D" & LastRow - x & ":" & "D" & LastRow)

       With ThisWorkbook.VBProject.VBComponents(VRS.CodeName).CodeModule
        Startline = .CreateEventProc("Change", "Worksheet") + 1
        .InsertLines Startline, "Dim rng As Range "
        Startline = Startline + 1
        .InsertLines Startline, "Set rng = Range(" & """" & CStr(rng.Address) & """" & ")"
        Startline = Startline + 1
        .InsertLines Startline, "If Target.Count > 1 Then Exit Sub"
        Startline = Startline + 1
        .InsertLines Startline, "If Intersect(Target, rng) Is Nothing Then Exit Sub"
        Startline = Startline + 1
        .InsertLines Startline, "MsgBox (""Value Changed!..."") "
       End With

コードは機能し、指定されたワークシートの codemodule に次の内容を書き込みます。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = Range("D58:D62")
If Target.Count > 1 Then Exit Sub  
If Intersect(Target, rng) Is Nothing Then Exit Sub
MsgBox ("Value Changed!...") 
End Sub`

このコードも機能し、範囲内のセルが変更されるとメッセージ ボックスが表示されます。ただし、VBE を閉じると、次のエラーが発生します。

Run-time error '9': Subscript out of range

デバッグを押すと、次の行に移動します。

With ThisWorkbook.VBProject.VBComponents(WS.CodeName).CodeModule

しかし、実際には次の行でエラーがスローされます。

Startline = .CreateEventProc("Change", "Worksheet") + 1
4

1 に答える 1

3

なぜそのエラーが発生するのかわかりませんが、これを回避する別のアプローチがあります

Sub Main()

    Dim ws As Worksheet
    Dim rng As Range
    Dim sCode As String

    Set ws = ThisWorkbook.Worksheets.Add
    Set rng = ws.Range("D1:D10")

    sCode = "Private Sub Worksheet_Change(ByVal Target As Range)" & vbNewLine & vbNewLine
    sCode = sCode & vbTab & "Dim rng As Range" & vbNewLine & vbNewLine
    sCode = sCode & vbTab & "Set rng = Me.Range(" & """" & rng.Address & """" & ")" & vbNewLine & vbNewLine
    sCode = sCode & vbTab & "If Target.Count > 1 Then Exit Sub" & vbNewLine
    sCode = sCode & vbTab & "If Intersect(Target, rng) Is Nothing Then Exit Sub" & vbNewLine & vbNewLine
    sCode = sCode & vbTab & "MsgBox (""Value Changed!..."") " & vbNewLine
    sCode = sCode & "End Sub"

    ThisWorkbook.VBProject.VBComponents(ws.CodeName).CodeModule.AddFromString sCode

End Sub
于 2011-05-27T18:11:14.060 に答える