Makro: Speichern unter neuem Namen wenn...

Excel-Datei "Master.xls" ist schreibgeschützt.
User macht was darin und stößt dann ein Makro an, das die Datei unter dem neuen Namen "Käse 2002-11-28.xls" abspeichern soll (In A1 ist das Datum =HEUTE() eingetragen):
Application.Dialogs(xlDialogSaveAs).Show Format("Käse ") & Format(Range("A1").Value, "yyyy-mm-dd")

Wenn die Datei allerdings schon unter dem neuen Namen abgespeichert ist, soll das Makro nur unter dem bestehenden neuen Namen nachspeichern.
Einmal am Tag soll also aus der Ursprungsdatei eine Datums-Datei ausgegliedert werden, die den ganzen Tag bis Feierabend nach jedem Makro-Vorgang immer nur nachgespeichert werden soll.

Die Bedingung krieg ich nicht gebacken. Da bin ich mit meinem Latein am Ende und mit dem VBA erst recht. Wer weiß Hilfe?

Grüße, klexy

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub klexy() If Len(ThisWorkbook.Name) = 10 Then Application.Dialogs(xlDialogSaveAs).Show Format("Käse ") & Format(Range("A1").Value, "yyyy-mm-dd") Else ThisWorkbook.Save End If End Sub

hier mein code:

ich weiß nicht wo ich das hineinschreiben soll. muss ich eine eigene sub machen?
##########################

rivate Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim Speichern As Boolean
Dim Pflichtfelder As Range
Dim Zelle As Range
Dim Empfänger, Titel As String ' Variablendeklaration
Empfänger = "mkanamueller@kpmg.at; test@test.at" ' Empfänger
Titel = "Testmail" 'Titel

If Application.UserName = "mkanamuelfler" Then Exit Sub ' Namen anpassen!

Set Pflichtfelder = Union(Worksheets("bmd").Range("A1"), Worksheets("bmd").Range("B2")) ' Pflichtfelder festlegen
Speichern = True

For Each Zelle In Pflichtfelder.Cells

If Zelle = "" Then
Speichern = False ' Speichern unterdrücken wenn Pflichtfelder leer sind

Exit For

End If

If Speichern = False Then
MsgBox "Sie haben nicht alle Pflichtfelder ausgefüllt!" & vbCrLf & "Speichervorgang wurde abgebrochen!" ' Fehlerausgabe - Messagebox
Cancel = True
End If

If Speichern = True Then
Application.Dialogs(xlDialogSendMail).Show Empfänger, Titel
End If

End Sub
###########################
danke

Beliebteste Forumthreads (12 Monate)

Makro: Speichern unter neuem Namen wenn...

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

312 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Makro: Speichern unter neuem Namen wenn...

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

312 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread