Speichern verändern

[kaptainluis]

Hallo an alle Excel Experten,

ich habe ein für mich unlösbares Problem von einem Kollegen erhalten.

Ich soll eine Excel Datei in den Format mit Makro und  ohne Makro speichern. Das habe ich mit einem Makro gemacht.

Sub speziellesspeichern()
Dim name As String

ChDir ActiveWorkbook.Path                                                   'Änderung des Hauptpfades

name = InputBox("Dateinamen eingeben", "spezielles Speichern", ActiveWorkbook.name)
Debug.Print name
Debug.Print Right(name, 5)
If name = "" Then                                                           '///"" ist abbrechen in inputbox
    Exit Sub
    End If
   
If Left(Right(name, 5), 1) = "." Or Left(Right(name, 4), 1) = "." Or Left(Right(name, 3), 1) = "." Or _
    Left(Right(name, 2), 1) = "." Or Left(Right(name, 2), 1) = "." Or name = "." Then
        MsgBox ("Der Dateiname darf keine Endung haben! Zb. 'Versuch.xls' ist verboten!")
        speziellesspeichern
        Exit Sub
    End If
   
dataname = ActiveWorkbook.Path & "\" & name
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=dataname, FileFormat:=xlWorkbookDefault     'ohne Makro
ActiveWorkbook.SaveAs Filename:=dataname, FileFormat:=xlOpenXMLWorkbookMacroEnabled   'mit Makro
Application.DisplayAlerts = True
MsgBox ("Speichern war erfolgreich. Gespeichert in: " & dataname)
End Sub


Leider ist die Lösung mit dem "Dateinamen ohne Punkt" eher schlecht gelungen und am liebsten hätte mein Kollege das so :

"Es soll ganz einfach sein und zwar immer wenn gespeichert wird, egal ob über Button, Strg+S, schließen oder sonst irgendwie gespeichert wird, es sollen beide Dateien gespeichert werden. Gerne mit den Hinweis im Dateinamen, dass die Datei mit oder ohne Makro ist.

Es soll kein Extra Button existieren oder sonst eine Abfrage kommen. "

Leider fällt mir dazu nichts ein. Das "Standart-Excel-Speichern" kann ich ja nicht beeinflussen...oder?  :20:

Ich bin für Ideen sehr dankbar!
Mfg kaptainluis

[Elex]

Hi

Es soll ganz einfach sein und zwar immer wenn gespeichert wird, egal ob über Button, Strg+S, schließen oder sonst irgendwie gespeichert wird, es sollen beide Dateien gespeichert werden. Gerne mit den Hinweis im Dateinamen, dass die Datei mit oder ohne Makro ist.

Ansatz:
den Code in das Modul "DieseArbeitsmappe"

Code:

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim Pfad As String
On Error Resume Next
Pfad = Replace(ActiveWorkbook.FullName, ".xlsm", ".xlsx")
Application.EnableEvents = False
Application.DisplayAlerts = False
 ActiveWorkbook.SaveAs Filename:=Pfad, FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

Wenn du jetzt die xlsm Datei speicherst, wird zusätzlich eine xlsx Datei gespeichert.

Gruß Elex

[Kuwer]

Hallo kaptainluis,

das wäre mein (getesteter) Vorschlag:

Option Explicit



Private Sub Workbook_AfterSave(ByVal Success As Boolean)

  Dim Pfad As String

  

  On Error Resume Next

  If Success Then

    Pfad = Me.FullName

    Application.EnableEvents = False

    Application.DisplayAlerts = False

    Me.SaveAs Filename:=Left(Pfad, InStrRev(Pfad, ".") - 1), FileFormat:=xlOpenXMLWorkbook

    Workbooks.Open Pfad

    Application.DisplayAlerts = True

    Application.EnableEvents = True

    Me.Close

  End If

End Sub

Gruß Uwe

[kaptainluis]

Hallo,

super das hat funktioniert! 

Leider wird durch "SaveAs" das ActiveWorkbook zu der xlsx Datei. Habe das Problem mit einer Workbookvariable gelöst! 

Danke nochmal! :17: 

Mein Code:


Private Sub Workbook_AfterSave(ByVal Success As Boolean)
 Dim DateiNamex As String
 Dim DateiNamem As String
 Dim wbkXlsx As Workbook
 
 On Error Resume Next
  DateiNamex = Replace(ActiveWorkbook.FullName, ".xlsm", ".xlsx")
  DateiNamem = ActiveWorkbook.FullName

  Application.EnableEvents = False
  Application.DisplayAlerts = False
  
  ActiveWorkbook.SaveAs Filename:=DateiNamex, FileFormat:=xlOpenXMLWorkbook
  
  Set wbkXlsx = ActiveWorkbook
  
  Workbooks.Open Filename:=DateiNamem
  
  wbkXlsx.Close False
  
  Application.DisplayAlerts = True
  Application.EnableEvents = True

End Sub