Speichern verändern
#1
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 Blush 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
Antworten Top
#2
Hi

Zitat: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
[-] Folgende(r) 1 Nutzer sagt Danke an Elex für diesen Beitrag:
  • kaptainluis
Antworten Top
#3
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
[-] Folgende(r) 1 Nutzer sagt Danke an Kuwer für diesen Beitrag:
  • kaptainluis
Antworten Top
#4
Heart 
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! Heart :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
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste