Makro umschreiben
07.01.2007 20:55:27
klaus
Denn Obersten habe ich in Meinem Programm eingebaut.
Jetzt habe ich eine frage, könnte mir einer den Makro unten mit der Speicher abfrage (ob Datei schon vorhanden ist ja/nein) oben in meinen Makro einfügen das bei mir auch die frage gestellt wird, ich habe schon getüftelt aber ich bekomme das nicht hin.
Danke für eure mühe Gruß Klaus
Private Sub CommandButton1_Click()
: Dim wks As Worksheet
: Dim wkb As Workbook
: Dim strRechNr As String
: Set wks = ActiveSheet
: strRechNr = Range("G10")
: Application.StatusBar = "Speichere " & strRechNr
: Application.ScreenUpdating = False
: Application.DisplayAlerts = False
: Application.Workbooks.Add
: Set wkb = ActiveWorkbook
: wks.Copy wkb.ActiveSheet
: ActiveSheet.Name = strRechNr
: 'Überflüssige Blätter löschen
: While Worksheets.Count > 1
: Worksheets(2).Delete
: Wend
: wkb.SaveAs "C:\Rechnungen\" & strRechNr & ".XLS"
: wkb.Close
: Application.DisplayAlerts = True
: Application.ScreenUpdating = True
: Application.StatusBar = ""
ActiveSheet.Cells(10, 7) = ActiveSheet.Cells(10, 7) + 1
End Sub
DateiName = "c:\Rechnungen\" & LTrim(Str$(ActiveSheet.Range("G10"))) + ".xls"
If Dir(DateiName) "" Then
GoTo Speicherabfrage
Else
ActiveWorkbook.SaveAs FileName:=DateiName
End If
Exit Sub
Speicherabfrage:
If MsgBox("Es ist bereits eine Rechnung unter dieser Nummer gespeichert. Soll die gespeicherte Rechnung gelöscht und durch diese ersetzt werden ?", vbYesNo) = vbYes Then
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:=DateiName
Application.DisplayAlerts = True
End If