XL-Vorlage: VBA-Code Workbook_Open nur ein Mal ausführen

[Rabe]

Hi,

ich habe eine Vorlage, bei der ich mit

Option Explicit

Private Sub Workbook_Open()
  Range("L1") = VBA.Environ("Username")
  Range("L2") = Date
End Sub

den Usernamen und das Datum in zwei Zellen schreibe.

Um zu verhindern, daß beim Öffnen der mit der Vorlage erstellten Datei diese Angaben wieder überschrieben werden, soll die Datei dann ohne Makros in einem frei wählbaren Verzeichnis abgespeichert werden.

Ich habe dazu dieses Makro gefunden und geändert (xlsm => xlsx). Leider sagt es aber, daß diese Erweiterung nicht mit dem ausgewählten Dateityp verwendet werden könne.
Wie stelle ich den richtigen Dateityp ein?

Code:

Option Explicit

'https://www.administrator.de/frage/excel-2010-speichern-dialog-best%C3%A4tigung-191283.html#comment-781665

Sub Speichern_ohne_Makros()
 
  Dim strDateiName As String
  Dim strVerzeichnisPfad As String
  Dim strSaveDatei As String
  Dim bSpeichernDialog As Boolean
  Dim bSpeichern As Boolean
 
  Application.EnableEvents = False
  Application.DisplayAlerts = False
   
  bSpeichern = True
  'Wert True = es wird defintiv gespeichert. False = nichts Speichern
 
  '------------------------------------------------------------------------
  'Festlegen, ob der Speichern unter Dialog (GetSaveAsFileName) überhaupt aufgerufen werden soll
  'Wert auf False setzen, wenn dies nicht gewünscht wird. Kann auch durch eine Zellabfrage (0 oder 1) erfolgen,
  'dann bSpeichernDialog = Range("X1"), wobei eine 0 Falsch und alles andere Wahr bedeutet. Ansonsten hier manuell festlegen
 
  'bSpeichernDialog = Range("X1")
  bSpeichernDialog = True
  '------------------------------------------------------------------------
 
  'Verzeichnispfad Vorschlag festlegen
  strVerzeichnisPfad = ""
 
  'Dateiname aus Zelle F4 des aktuellen Blatts holen und Datum (Sortierbar) und Dateierweiterung dranhängen. Die yyyymmdd ist bei Sortierung wichtig
  strDateiName = "Checkliste Platinen-Übergabe" & Format(Date, "_yyyymmdd") & ".xlsx"
 
  'Speicherpfad und Dateiname zusammenfügen
  strSaveDatei = strVerzeichnisPfad & strDateiName
 
  '------------------------------------------------------------------------
 
  'Mit dem jetzt vorhandenen Dateiname inkl. Pfad abfragen, ob der Speicherort OK ist.
  'Dazu das Dialogfenster GetSaveAsFilename aufrufen (Achtung, mus zwingend bestätigt werden
  'Dies aber nur, falls der Dialog abgefragt werden soll. bSpeicherDialog regelt dies über Wahr / Unwahr
  If bSpeichernDialog Then
     'Dialog zum Bestätigen des Speicherorts und Dateiname aufrufen. Achtung, kann auch mit Abbrechen beendet werden
     'Zuweisen des endgültigen Dateinamens oder ein Falsch wenn Abbruch
     strSaveDatei = SpeichernUnter(strSaveDatei)
     
     'Wurde abgebrochen?
     If strSaveDatei = "Falsch" Then
        'Es wurde im Speicherdialog auf Abbrechen geklickt. Nichts zu tun und Tschüß
        bSpeichern = False
        'Exit Sub
        'Mit Exit Sub kann hier die gesamte restliche SUB beendet werden. Unschön, aber manchmal nötig
     Else
        'Im Dialog wurde auf Speichern geklickt
        bSpeichern = True
     End If
  Else
     'Der Dialog sollte nicht aufgerufen werden, also wird der DateiPfad und Name als gegeben und nicht änderbar angenommen.
     bSpeichern = True
  End If
  '------------------------------------------------------------------------
 
  'Bestimmen ob dies eine Neue datei oder eine schon vorhandene ist.
  'Falls neu, das .SaveAs verwenden. Wenn die Datei schon vorhanden ist, wird zwingend ein Dialog wegen überschreibung eingeblendet
  'daher falls die Datei schon vorhanden ist, das .Save verwenden was einen Überschreiben Dialog nicht aufruft
  Do While bSpeichern
     If DateiVorhanden(strSaveDatei) Then
        'Datei wird überschrieben OHNE Dialog
        ActiveWorkbook.Save
     Else
        'Datei wird erstmalig erstellt Ohne Dialog
        ActiveWorkbook.SaveAs strSaveDatei
     End If
     bSpeichern = False
  Loop
 
  Application.DisplayAlerts = True
  Application.EnableEvents = True
 
End Sub

Function SpeichernUnter(VorgabeName As String) As String
  ' Dialog Aufrufen um den Speicherort zu bestätigen oder einen anderen Speicherort anzugeben und zu bestätigen
  'Kann auch abgebrochen werden. dann ist der Rückgabewert ein "Falsch", sonst der Pfad und Dateiname
 
  SpeichernUnter = Application.GetSaveAsFilename(InitialFileName:=VorgabeName, Filefilter:="Excel Dateien (*.xlsx),*.xlsx*", FilterIndex:=1, Title:="Speichern unter...", ButtonText:="speichern")
  'strSaveDatei = SpeichernUnter
End Function

Function DateiVorhanden(DateipfadName As String) As Boolean
  'Über die Dir Funktion schauen ob die Datei existirt. Wenn ja, wird der dateiname zurückgegeben, sonst ein null String
  'Mit dem vergleich > wird geschaut ob etwas zurück kam. Ergebniss ist True oder False
 
  DateiVorhanden = (Dir(DateipfadName) > "")
 
End Function

[Rabe]

Eigenantwort:

Ich habe dazu dieses Makro gefunden und geändert (xlsm => xlsx). Leider sagt es aber, daß diese Erweiterung nicht mit dem ausgewählten Dateityp verwendet werden könne.
Wie stelle ich den richtigen Dateityp ein?

also, ich habe an die Speicher-Zeile folgendes angehängt:
ActiveWorkbook.SaveAs strSaveDatei, FileFormat:=xlOpenXMLWorkbook

jetzt geht es!

[schauan]

Hallo Ralf,

das war im Prinzip die Sache mit der 51 und 52 usw. als Nummer für die verschiedenen Fileformate, da hatten wir glaube auch schon Fragen. Excel tut sich etwas schwer, wenn man beim Speichern das Fileformat wechselt. Bleibt man dabei, geht es in der Regel auch ohne Angabe.

Siehe zu den Formaten und Nummern die Übersicht bei Microsoft
https://msdn.microsoft.com/de-de/library...98017.aspx