Makro problem
08.07.2005 13:15:17
Andre
Ich habe folgenden Code, der bei Änderung in Zelle A5 die Datei neu abspeichert. Dies funktioniert auch, doch ich möchte zugleich, dass die Daten im Shett ("NSM Empfang HR") im Bereich ("B5:I3000") gelöscht werden. Das Shett wird zwar ein und wieder ausgeblendet, doch es wird nichts gelöscht. Ich hoffe mir kann jemand helfen den Fehler zu beseitigen.
Danke im voraus!
Private Sub Worksheet_Change(ByVal Target As Range)
Dim fn As String
If Not Intersect(Range("A5"), Target) Is Nothing Then
If Range("A5") < 1999 Or Range("A5") > 2100 Then
'kein gültiger Wert
MsgBox "Jahreszahl muss zwischen 1999 und 2100 liegen!"
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
Else
'Wert OK
fn = ThisWorkbook.Path & "\" & ActiveSheet.Name & " " & "FY" & " " & Range("A5") & ".xls"
If MsgBox("Die Datei wird gespeichert unter " & fn & vbLf & _
"Fortfahren?", vbQuestion + vbOKCancel, "Sicherheitsabfrage") = vbOK Then
'Datei speichern
Application.EnableEvents = False
On Error Resume Next
ThisWorkbook.SaveAs Filename:=fn
If Err.Number > 0 Then
'Fehler beim Speichern
MsgBox Err.Description, vbCritical, "Fehler Nr. " & Err.Number
Err.Clear
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
Else
MsgBox "Datei wurde gespeichert unter " & ThisWorkbook.FullName, vbInformation
End If
Application.EnableEvents = True
Else
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
End If
End If
End If
Sheets("NSM Empfang HR").Visible = True
Sheets("NSM Empfang HR").Select
Range("B5:I3000").Select
Selection.ClearContents
Range("B5").Select
Sheets("NSM Empfang HR").Visible = xlVeryHidden
End Sub
Anzeige