Laufzeitfehler mit Excel 2007

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If [L508] > 0 Then MsgBox " Achtung!" & Chr(13) & Chr(13) & " Falsche Eingabe. " _ Hier mal das Makro: Sub Blätter_erstellen() Sheets("Vorgaben").Unprotect Password:="XXX" Sheets("Mustermann_M").Unprotect Password:="XXX" Dim Zelle As Range With Sheets("Vorgaben") On Error Resume Next For Each Zelle In .Range(.Cells(9, 2), .Cells(107, 2).End(xlUp)).SpecialCells( _ xlCellTypeConstants) Err = 0 Sheets(Zelle.Value).Select Select Case Err Case 0 Case Else ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) ActiveSheet.Name = Zelle.Value ActiveSheet.Tab.ColorIndex = 10 ' = Grün Sheets("Mustermann_M").Cells.Copy Destination:=ActiveSheet.Cells Range("A7").Select ActiveWindow.FreezePanes = True Range("D8").Select ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _ Password:="XXX" ActiveSheet.EnableSelection = xlUnlockedCells With ActiveWindow .DisplayGridlines = False .DisplayHeadings = False End With End Select Next On Error GoTo 0 Sheets("Mustermann_M").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _ Password:="XXX" .Select End With Application.DisplayAlerts = False Sheets("Ende").Delete Application.DisplayAlerts = True Sheets("Vorgaben").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:= _ "XXX" 'neu ActiveSheet.EnableSelection = xlUnlockedCells Range("C2").Select End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo
Natürlich mal wieder schade das man zum Testen nachbauen muss :(
Du hast ja schließlich die Datei schon (fast) fertig.
Hättest sie also hier zur Verfügung stellen können/sollen.
noch eine paar Anmerkungen:
Wenn das Makro Blätter_erstellen() ein zweites Mal gestartet wird, gibt es diesen VBA-Fehler
(da das Sheet("Ende") bereits gelöscht wurde.)
Desweiteren sollten Variablen deklariert werden.
Dim Zelle as (Typ)
und das versteh ich auch nicht:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If [L508] > 0 Then MsgBox " Achtung!" & Chr(13) & Chr(13) & " Falsche Eingabe. "
Bei Selection wird mE keine Eingabe gemacht

und wenn der Code tatsächlich so dasteht, wie gepostet
Zitat:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If [L508] > 0 Then
MsgBox " Achtung!" & Chr(13) & Chr(13) & " Falsche Eingabe. " _

da fehlt sowieso das End If und das End Sub
Ich konnte beim Test mit XL2007 den Laufzeitfehler
also nur erzeugen beim 2. Aufruf des Makros Blätter_erstellen(), da das Sheet("Ende")
bereits gelöscht wurde.
Gruß Matthias

Hallo Markus,
es ist immer etwas problematisch beim Auftreten von Fehlern mit Resume Next zu arbeiten. Das kann zu unerwarteten Ergebnissen führen, wenn nicht einkalkulierte Fehler auftreten.
Besser ist es vor bestimmten Aktionen explizite Prüfungen (in deinem Fall, ob Blatt mit dem Namen bereits vorhanden ist) durchzuführen, statt fehlerabhängig weiter zu arbeiten. Fehler während der Makroausführung sollte man in einem separaten Abschnitt der Prozedur auswerten und ggf. gezielte Aktionen einleiten.
Nachfolgend mein Vorschlag für deine Prozedur inkl. einer Funktion zur Prüfung der Blattnamen.
Gruß
Franz

' Hier mal das Makro:
Sub Blätter_erstellen()
Dim Zelle As Range
On Error GoTo Fehler
Sheets("Vorgaben").Unprotect Password:="XXX"
Sheets("Mustermann_M").Unprotect Password:="XXX"
With Sheets("Vorgaben")
For Each Zelle In .Range(.Cells(9, 2), .Cells(107, 2).End(xlUp)).SpecialCells( _
xlCellTypeConstants)
If fncSheet_vorhanden(Zelle.Text) = False Then
ThisWorkbook.Sheets.Add after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = Zelle.Value
ActiveSheet.Tab.ColorIndex = 10  ' = Grün
Sheets("Mustermann_M").Cells.Copy Destination:=ActiveSheet.Cells
Range("A7").Select
ActiveWindow.FreezePanes = True
Range("D8").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
Password:="XXX"
ActiveSheet.EnableSelection = xlUnlockedCells
With ActiveWindow
.DisplayGridlines = False
.DisplayHeadings = False
End With
End If
Next
Sheets("Mustermann_M").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
Password:="XXX"
.Select
End With
If fncSheet_vorhanden("Ende") = True Then
Application.DisplayAlerts = False
Sheets("Ende").Delete
Application.DisplayAlerts = True
End If
Sheets("Vorgaben").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, _
Password:="XXX" 'neu
ActiveSheet.EnableSelection = xlUnlockedCells
Range("C2").Select
Fehler:
With Err
Select Case .Number
Case 0
'do nothing alles ok
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
End Sub
Function fncSheet_vorhanden(sBlattname As String, Optional wb As Workbook) As Boolean
'Überprüft, ob ein Blatt im Workbook vorhanden ist
Dim oSheet As Object
If wb Is Nothing Then Set wb = ActiveWorkbook
For Each oSheet In wb.Sheets
If LCase(oSheet.Name) = LCase(sBlattname) Then
fncSheet_vorhanden = True
Exit For
End If
Next
End Function

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread