SaveAs Dialog anpassen
18.07.2022 00:54:08
BriBri
Unter all den VBA Kennern und Könnern kann mir sicher jemand weiterhelfen. Ich erstelle in einer Excel Mappe, in der einige Kalkulationen gemacht werden, letztendlich zwei Sheets mit den Namen "Order" und "ATP Order". Aus diesen wird dann in der Excel Mappe zwei Sheets mit den Namen Order 1 und ATP Order 1 erstellt. Die Sheets "Order 1" und "ATP Order 1" werden unter den Namen "Order" und "ATP Order" in eine neue Arbeitsmappe im selben Ordner wie die ursprüngliche Arbeitsmappe abgespeichert. Danach werden die Sheets "Order 1" und "ATP Order 1" in der ursprünglichen Arbeitsmappe gelöscht.
Das funktioniert alles gut, solange die neue Arbeitsmappe noch nicht existiert.
Existiert sie aber bereits, öffnet der SaveAs Befehl eine Dialogbox Ja (überschreiben)-Nein-Abbrechen. Bei Nein und Abbrechen wird eine Arbeitsmappe kreiert, die dann MappeZahl.xls heißt, in der das Sheet "Order" steht, aber kein Sheet "ATP Order". In der ursprünglichen Mappe stehen immer noch "Order 1" und "ATP Order 1" , da der Code ja abgebrochen wurde.
Wie kann ich mit VBA bei der Dialogbox+Nein ein neues Dialogfenster öffnen, in das ein neuer Speichername vergeben werden kann?
Wie kann ich mit VBA bei der Dialogbox+Abbrechen verhindern, dass eine neue Arbeitsmappe MappeZahl.xls aufgeht? Und wie lösche ich in diesem Fall die beiden Sheets "Order 1" und "ATP Order 1" aus der ursprünglichen Mappe?
Ich weiß, der Text ist ein wenig lang geraten, aber ich hoffe ihr könnt mir helfen.
Brigitte
Option Explicit
Sub NewWbinFolder()
'New Workbook "Customer Name_Lab Name_calc_Date" is stored in the same folder as CalcTool
Dim strName As String, WbO As Workbook, WbN As Workbook
Dim strLab As String
Dim strDesign As String
Set WbO = ThisWorkbook 'Old Workbook
Application.ScreenUpdating = False
strName = WbO.ActiveSheet.Range("B1")
strLab = WbO.ActiveSheet.Range("B2")
strDesign = "ASC.In_Design.thmx"
WbO.Sheets("Order 1").Copy
Set WbN = ActiveWorkbook 'New Workbook
With WbN.ActiveSheet.UsedRange
.Value = .Value
End With
ActiveSheet.Name = "Order"
WbN.SaveAs ThisWorkbook.Path & "\" & strName & "_" & strLab & "_calc" & Format(Date, "_YYYY_MM_DD"), 51
WbO.Sheets("ATP Order 1").Copy after:=WbN.Sheets(WbN.Sheets.Count)
WbN.ActiveSheet.Name = "ATP Order"
ActiveWorkbook.ApplyTheme ThisWorkbook.Path & "\" & strDesign & "" 'Color code taken from calculation file
WbN.Close True 'new storage
Application.DisplayAlerts = False
WbO.Sheets("Order 1").Delete
WbO.Sheets("ATP Order 1").Delete
Application.ScreenUpdating = True
End Sub