nach dem öffnen automatisch speichern

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub workbook_open() Call Workbook_SaveAs End Sub Private Sub Workbook_BeforeSave(ByVal SaveAs As Boolean, Cancel As Boolean) If SaveAs Then With ThisWorkbook.VBProject.VBComponents(1).CodeModule .DeleteLines 1, .CountOfLines End With End If End Sub Private Sub Workbook_SaveAs() Dim DName As String Dim Pfad As String Dim Dateiname As String Pfad = "c:\0000 Intern\0200 Doku\0274 Mangeltool\Erfassung" DName = " Mangelerfassungsliste" Dateiname = Pfad & "\" & Format(Now, "YYMMDD") & DName & ".xlsm" ThisWorkbook.SaveAs Filename:=Dateiname End Sub

Private Sub Workbook_Open() Dim strPfad As String, strDateiNeu As String, strOriginalName As String strPfad = "c:\0000 Intern\0200 Doku\0274 Mangeltool\Erfassung" 'A N P A S S E N ! ! ! strOriginalName = "Originalname.XLTM" 'Name der Template-Datei A N P A S S E N ! ! ! strDateiNeu = strPfad & "\" & Format(Now, "YYMMDD") & " Mangelerfassungsliste" ' Debug.Print strDateiNeu If LCase(Me.FullName) = LCase(strDateiNeu & ".xlsm") Then 'do nothing, bereits erstellte Datei wird geöffnet Else If Dir(strDateiNeu & ".xlsm") "" Then MsgBox "Datei """ & strDateiNeu & ".xlsm"" existiert bereits!" & vbLf & _ "Vorlage wird ohne Speichern wieder geschlossen" & vbLf & _ "Die existierende Datei geöffnet.", _ vbInformation + vbOKOnly, "Mangelliste anlegen" Application.EnableEvents = False Application.Workbooks.Open strDateiNeu Application.EnableEvents = True Me.Close savechanges:=False Else If LCase(Me.Name) = LCase(strOriginalName) Then 'bei direktem Öffnen des Templates Me.SaveAs Filename:=strDateiNeu, FileFormat:=52, addtomru:=True ElseIf Me.Path = "" Then 'bei Öffnen des Templates via Datei -- Neu Me.SaveAs Filename:=strDateiNeu, FileFormat:=52, addtomru:=True End If End If End If End Sub

Hallo Franz,
ich habe es in mein Dokument eingefügt und angepasst, aber es läuft nicht wirklich besser als das vorherige Ergebnis.
Problem Nr. 1 - Das Löschen des Makros aus der automatisch abgespeicherten Datei funktioniert nicht. Wenn ich also die Datei nach dem Schließen wieder öffne versucht es eine neue Datei abzulegen. Dadurch konnte ich auch gleich Problem Nr. 2 feststellen - wenn es die generierte Datei schon gibt (das kann vorkommen, wenn verschiedene Kollegen an einem Tag eine Mangelliste erstellen - gerade in der Bauabnahme) dann muss entweder eine laufende Nummer automatisch an den Dateinamen angefügt werden oder von mir aus auch die Uhrzeit oder aber ich muss wenigstens die Möglichkeit haben, die Datei dann unter einem anderen Namen zu speichern (so war es bei meinem Code).
Der Code, den ich gepostet habe funktionierte eigentlich gut. Nur das das Löschen des Makros nicht funktionierte.
Hättest Du vielleicht noch eine Idee in bezug auf meinen geposteten Code?
Vielen lieben Dank schon einmal vorab!
Gruß
Sandra

Hallo Sandra,
ich hab mir dein Makro nochmals vorgenommen.
Wenn die Vorlage geöffnet wird oder via Datei-Neu eine neue Datei auf Basis der Vorlage erstellt wird, dann wird direkt der Speichern-unter-Dialog angezeigt mit dem neuen Namen als Namens-Vorschlag. Wird ein schon vorhandener Name benutzt wird dies geprüft und ggf. der Auswahldialog nochmals angezeigt.
Als zusätzlichen Schutz die Eigenschaft "schreibgeschützt" im Dateimanager aktivieren.
So kann die Vorlage nicht versehentlich überschrieben werden, falls beim Öffnen der Vorlage die Makros deaktiviert werden.
Das Ändern des VBA-Projekts (Löschen von Zeilen) ist schwierig umzusetzen. So müsste z.B. jeder Anwender die Einstellung "Zugriff auf VBA-Projektmodell erlauben" aktivieren unter den Optionen/Sicherheitscenter/Einstellungen für Makros. Auch der Zugriff eines Makros auf das eigene VBA-Projekt ist nicht ohne weiteres umzusetzen.
Gruß
Franz

Option Explicit
Private Const strNameVorlage As String = "Mangelerfassungsliste.xltm" 'Name der Vorlagedatei
Private Sub workbook_open()
If LCase(Me.Name) = LCase(strNameVorlage) Or Me.Path = "" Then
Call Workbook_SaveAs
End If
End Sub
Private Sub Workbook_SaveAs()
Dim DName As String
Dim Pfad As String
Dim Dateiname As Variant, strPrompt1 As String, strPrompt2 As String
Pfad = "c:\0000 Intern\0200 Doku\0274 Mangeltool\Erfassung"
Pfad = "D:\Test\ZwischenOrdner"
DName = " Mangelerfassungsliste"
Dateiname = Pfad & "\" & Format(Now, "YYMMDD hhmmss") & DName & ".xlsm"
AuswahlDateiname:
With Application.FileDialog(msoFileDialogSaveAs)
.Title = "Neue Mangelerfassungsliste anlegen - vorgeschlagenen Namen anpassen falls gewü _
nscht"
.FilterIndex = 2 'normalerweise xlsm-Datei
.InitialFileName = Dateiname
If .Show = -1 Then
Dateiname = .SelectedItems(1)
If Dir(Dateiname) = "" Then
ThisWorkbook.SaveAs Filename:=Dateiname, FileFormat:=52, addtomru:=True
Else
If MsgBox("Der gewählte Dateiname existiert bereits. " & vbLf _
& "Anderen Namen wählen?", _
vbQuestion + vbOKCancel, "") = vbOK Then
GoTo AuswahlDateiname
Else
Me.Close savechanges:=False
End If
End If
Else
Me.Close savechanges:=False
End If
End With
End Sub

Beliebteste Forumthreads (12 Monate)

nach dem öffnen automatisch speichern

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

46 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

nach dem öffnen automatisch speichern

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

46 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread