AW: VBA Code per Makro in Arbeitsblatt einfügen
21.08.2006 21:23:42
Peter
Hallo Andy,
es geht auf diverse Arten, z. B. kannst du das Makro in eine Text-Datei schreiben, die du dann einliest und in das Tabellenblatt einfügst z. B. so:
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
.AddFromFile ImportDatei
End With
oder auch direkt aus einem Makro, wie im Beispiel:
Option Explicit
Sub WB_Code_via_VBA_Kapitel()
Const WS As String = "Kapitel"
Dim VBC As Object
Dim LineNr As Integer
With ThisWorkbook.VBProject.VBComponents(Worksheets(WS).CodeName).CodeModule
LineNr = .CreateEventProc("Change", "Worksheet")
.InsertLines LineNr + 1, " "
.InsertLines LineNr + 2, "Dim r As Long"
.InsertLines LineNr + 3, "Dim wsB As Worksheet"
.InsertLines LineNr + 4, "Dim wsC As Worksheet"
.InsertLines LineNr + 5, " "
.InsertLines LineNr + 6, " If Target.Column = 7 And Target.Row > 1 Then"
.InsertLines LineNr + 7, " If Target.Count = 1 Then"
.InsertLines LineNr + 8, " Set wsB = Sheets(""Lotus Notes"")"
.InsertLines LineNr + 9, " Set wsC = Sheets(""Binf neu (2)"")"
.InsertLines LineNr + 10, " r = Target.Row - 1"
.InsertLines LineNr + 11, " Application.EnableEvents = False"
.InsertLines LineNr + 12, " On Error GoTo ERRH"
.InsertLines LineNr + 13, " Range(Cells(r, 1), Cells(r, 6)).Copy Range(Cells(r + 1, 1), Cells(r + 1, 6))"
.InsertLines LineNr + 14, " wsB.Range(wsB.Cells(r, 1), wsB.Cells(r, 6)).Copy wsB.Range(wsB.Cells(r + 1, 1), wsB.Cells(r + 1, 6))"
.InsertLines LineNr + 15, " wsC.Range(wsC.Cells(r, 1), wsC.Cells(r, 9)).Copy wsC.Range(wsC.Cells(r + 1, 1), wsC.Cells(r + 1, 9))"
.InsertLines LineNr + 16, " Range(Cells(r, 8), Cells(r, 9)).Copy Range(Cells(r + 1, 8), Cells(r + 1, 9))"
.InsertLines LineNr + 17, " wsB.Range(wsB.Cells(r, 7), wsB.Cells(r, 12)).Copy wsB.Range(wsB.Cells(r + 1, 7), wsB.Cells(r + 1, 12))"
.InsertLines LineNr + 18, " wsC.Range(wsC.Cells(r, 22), wsC.Cells(r, 26)).Copy wsC.Range(wsC.Cells(r + 1, 22), wsC.Cells(r + 1, 26))"
.InsertLines LineNr + 19, " Set wsB = Nothing"
.InsertLines LineNr + 20, " Set wsC = Nothing"
.InsertLines LineNr + 21, " End If"
.InsertLines LineNr + 22, " End If"
.InsertLines LineNr + 23, " "
.InsertLines LineNr + 24, "ERRH:"
.InsertLines LineNr + 25, " "
.InsertLines LineNr + 26, " Application.EnableEvents = True"
End With
End
Sub
Viele Grüße Peter
Eine kurze Nachricht, ob es läuft, wäre nett - danke.