Hallo !
Ich bin am verzweifeln. Problem : mein Programm laeuft fehlerfrei mit geoeffnetem VBE, aber nicht ohne VBE.
Habe ich den VBE nicht offen bei Programmstart, stuerzt Excel ab (automatisierungsfehler...). Seltsamerweise stuerzt es an der gleichen Stelle auch ab, wenn ich vorher den VBE im Laufe des Makros oeffne.
Das ganze geschieht am Ende meines Progs. Dann, wenn verschiedenen worksheets noch Ereignisprozeduren angefuegt werden sollen.
Hier der Code:
' Am Schluss werden nun noch die Ereignisprozeduren in die Erstellten Diagrammblaetter eingetragen
Dim boolv As Boolean
boolv = False
' den VBE oeffne ich, um an die Codenamen der im Laufe des Makros erstellten Blaetter zu kommen
With Application.VBE.MainWindow
If .Visible = False Then
boolv = True
.SetFocus
.Visible = True
End If
End With
For idia = 1 To UBound(dia)
If dia(idia) = True Then
Select Case idia
Case Is = 1
ereignis "B1_RW"
Case Is = 2
ereignis "B2_RW"
End Select
End If
Next idia
With Application.VBE.MainWindow
If boolv = True Then
.SetFocus
.Visible = False
End If
End With
End Sub
~f~
' in diesem Teil erfolgt der Absturz (beim zweiten durchlauf - also "B2_RW") Die msgBox wird noch angezeigt, aber dann will Excel schon Microsoft verstaendigen - ohne dass ich noch gelegenheit bekomme die msgbox wegzuklicken.
~f~
Option Explicit
Sub ereignis(ByRef blattname1 As String)
Dim ii As Long, zielname As String
' nur zum debuggen
If blattname1 = "B2_RW" Then
MsgBox "Schoenen Gruß"
End If
' Worksheets(blattname1).Activate
zielname = Worksheets(blattname1).CodeName
Select Case blattname1
Case Is = "B1_RW"
With ActiveWorkbook.VBProject.VBComponents(zielname).CodeModule
ii = .CreateEventProc("SelectionChange", "worksheet") + 1
.InsertLines ii, "dim rngg as range"
.InsertLines ii + 1, "i = 0"
.InsertLines ii + 2, "For Each rngg In Target: i = i + 1: Next rngg"
.InsertLines ii + 3, "If i <> 1 Then"
.InsertLines ii + 4, "Exit Sub"
.InsertLines ii + 5, "End If"
.InsertLines ii + 6, "Select Case Target.Column"
.InsertLines ii + 7, "Case 4 To 10, 15 To 21"
.InsertLines ii + 8, "If Target.Row > 4 And Target.Row < 12 Then"
.InsertLines ii + 9, "If Target.value > 0 Then"
.InsertLines ii + 10, "zeiley = Target.row"
.InsertLines ii + 11, "spaltex = Target.column"
.InsertLines ii + 12, "anzahlmonate =" & anzahlmonate
.InsertLines ii + 13, "Mliste.show"
.InsertLines ii + 14, "End If"
.InsertLines ii + 15, "End If"
.InsertLines ii + 16, "End Select"
End With
Case Is = "B2_RW"
With ActiveWorkbook.VBProject.VBComponents(zielname).CodeModule
ii = .CreateEventProc("SelectionChange", "worksheet") + 1
.InsertLines ii, "dim rngg as range"
.InsertLines ii + 1, "i = 0"
.InsertLines ii + 2, "For Each rngg In Target: i = i + 1: Next rngg"
.InsertLines ii + 3, "If i <> 1 Then"
.InsertLines ii + 4, "Exit Sub"
.InsertLines ii + 5, "End If"
.InsertLines ii + 6, "Select Case Target.Column"
.InsertLines ii + 7, "Case 5 To 13"
.InsertLines ii + 8, "If Target.Row > 6 And Target.Row < 14 Then"
.InsertLines ii + 9, "If Target.value > 0 Then"
.InsertLines ii + 10, "zeiley = Target.row"
.InsertLines ii + 11, "spaltex = Target.column"
.InsertLines ii + 12, "anzahlmonate =" & anzahlmonate
.InsertLines ii + 13, "Mliste.show"
.InsertLines ii + 14, "End If"
.InsertLines ii + 15, "End If"
.InsertLines ii + 16, "End Select"
End With
Case Else
End Select
Kann mir jemand helfen ? Vielleicht muss ich eine Function verwenden ? Ob ich mittels byref oder byval uebergebe aendert jedenfalls nichts.
Schoene Grueße,
Knut