AW: Private Sub deaktivieren
30.03.2008 15:10:00
fcs
Hallo Lenea und Karsten,
ich bin ja der "Verbrecher" der ursprünglichen Prozedur zum Eintragen der Formeln in Leerzeilen, wenn Werte eingetragen werden. Diese hatte ich ja mit der Change-Ereignis-Prozedur realisiert.
Wenn diese jetzt extreme Probleme bei der Ausführung anderer Ereignisprozeduren macht, dann gibt es verschieden Möglichkeiten:
1. In der Prozedur, die "ungestört" durchlaufen soll, werden am Anfang die Ereignisprozeduren deaktiviert und am Ende wieder aktiviert.
Das haben die anderen Helfer hier schon versucht euch nahe zu bringen.
2. In einem Modul wird eine Public Variable als Boolean deklariert.
Zu Beginn der Prozedur, die "ungestört" durchlaufen soll, wird diese Variable auf True gesetzt, am Ende wieder auf False.
In den Ereignisprozeduren, deren Code während der Prozedur nicht abgearbeitet werden soll, wird zu Beginn in einer If-Anweisung der Wert der Public Variablen abgefragt. Bei True wird die Ereignisprozedur per "Exit Sub" sofort wieder verlassen.
3. Ihr verwendet zum Ergänzen/Einfügen der Leerzeilen mit Formel kein Ereignismakro, sondern Prozeduren, die nur auf Anforderung (z.B per Button-Klick) eine Leerzeile mit Formeln einfügen bzw.anfügen. Das schaut dann etwa wie folgt aus.
Gruß
Franz
'## Die folgenden Prozeduren werden immer im aktiven Blatt ausgeführt ##
Sub LeerenachZeile2()
'Makro für Button, 1. Zeile mit Formeln in Zeile 2
Call LeerzeilemitFormelnEinfuegen(lngZeile1:=2)
End Sub
Sub LeereZeileanfuegen()
'Makro für Button, Formeln ab Zeile 2, Spalte 10 ist eine der Spalten mit Formel
Call LeerzeilemitFormelnAnfuegen(lngZeile1:=2, lngSpalteFormel:=10)
End Sub
Sub LeerzeilemitFormelnEinfuegen(lngZeile1 As Long)
'Fuegt an Position der aktiven Zelle eine Leerzeile ein und _
übernimmt Formeln aus Zeile darüber
Dim lngZeile As Long
Dim objZelle As Range
'lngZeile1 '1. Zeile mit Formel, vor dieser werden keine Zeilen eingefügt
Set objZelle = ActiveCell
lngZeile = objZelle.Row
If lngZeile > lngZeile1 Then
'Leerzeile einfügen
objZelle.EntireRow.Insert shift:=xlShiftDown
'Formeln aus Zeile oberhalb herunter kopieren
For Each objZelle In Range(Cells(lngZeile, 1), _
Cells(lngZeile, Cells.SpecialCells(xlCellTypeLastCell).Column))
If objZelle.Offset(-1, 0).HasFormula Then
Range(objZelle.Offset(-1, 0), objZelle).FillDown
End If
Next
Else
MsgBox "Zeilen werden nur unterhalb von Zeile " & lngZeile1 & " eingefügt!"
End If
Set objZelle = Nothing
End Sub
Sub LeerzeilemitFormelnAnfuegen(lngZeile1 As Long, lngSpalteFormel As Long)
'Fuegt am Ende der Liste Leerzeile ein und übernimmt Formeln aus Zeiledrüber
Dim lngZeile As Long, objZelle As Range
'lngZeile1 = 1. Zeile mit Formel, muss ausgefüllt sein
'lngSpalteDormel = eine der Spalten mit einer Formel
'Letzte ausgefüllte Zelle in Spalte mit Formel ermitteln
Set objZelle = Cells(ActiveSheet.Rows.Count, lngSpalteFormel).End(xlUp)
lngZeile = objZelle.Row
If lngZeile >= lngZeile1 Then
'Letzte Zeile in nächste Zeile kopieren
objZelle.EntireRow.Copy Destination:=Cells(lngZeile + 1, 1)
'Inhalte in Zellen ohne Formeln löschen
For Each objZelle In Range(Cells(lngZeile + 1, 1), _
Cells(lngZeile + 1, Cells.SpecialCells(xlCellTypeLastCell).Column))
If Not objZelle.HasFormula Then
objZelle.ClearContents
End If
Next
Cells(lngZeile + 1, 1).Select
Else
MsgBox "Spalte " & lngSpalteFormel & " ist in Zeile " & lngZeile1 _
& " noch nicht ausgefüllt!"
End If
Set objZelle = Nothing
End Sub