Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1668to1672
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Datei beim Schließen an einen zweiten Ort speicher

Datei beim Schließen an einen zweiten Ort speicher
14.01.2019 12:16:58
Sascha
Hallo,
ich benötige Hilfe bei folgendem Problem:
Ich möchte eine Excel-Datei beim Schließen automatisch an einen zweiten Ort speichern.
Die Originaldatei hat die Endung .xlsm. Die Kopie sollte als .xls- oder .xlsx-Datei gespeichert werden und mit jeweils einem Kennwort zum Öffnen sowie einem zum Bearbeiten der Datei versehen werden.
Bisher habe ich dazu folgendes Makro erstellt:
Option Explicit
Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.EnableEvents = False
ThisWorkbook.Save
Application.DisplayAlerts = False
ThisWorkbook.SaveCopyAs "R:\Test\" & ThisWorkbook.Name & ".xls"
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub
Das Speichern an dem zweite Ort beim Schließen der Originaldatei funktioniert auch. Allerdings wird meine Datei dann als Dateiname.xlsm.xls gespeichert, mit der Folge, dass beim Öffnen dieser Datei ein Hinweis erscheint, dass der Dateiname und die Dateiendung nicht zusammen passen.
Darüber hinaus fehlt mir eine Idee, wie das mit den beiden Kennwörtern funktionieren könnte.
Hätte jemand eine Idee?
Vielen Dank im Voraus,
Sascha

12
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datei beim Schließen an einen zweiten Ort speicher
14.01.2019 12:35:25
Nepumuk
Hallo Sascha,
wie der Methodenname SaveCopyAs schon sagt, wird nur eine Kopie der Mappe gespeichert. Wenn du das Dateiformat ändern und Kennwörter mitgeben willst, dann musst du zwingend die SaveAs - Methode benutzen.
Gruß
Nepumuk
AW: Datei beim Schließen an einen zweiten Ort speicher
14.01.2019 13:14:38
UweD
Hallo
wie Nepumuk schon geschrieben hat, sind diese Zusatzoptionen bei SaveCopyAs nicht möglich.
mit Zwischenschritt ging es aber
Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim WB, Pfad As String, Dateixls As String, Ext As String
    On Error GoTo Fehler
    
    Cancel = True 'stoppt das aktuelle speichern 
    
    Pfad = "X:\Temp\Test\" 'mit \ am Ende 
    Ext = ".xls"
    Dateixls = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & Ext
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    
        'Original speichern 
        ThisWorkbook.Save
    
        'Kopie speichern 
        ThisWorkbook.SaveCopyAs Filename:=Pfad & Dateixls
        
        'Kopie öffnen 
        Set WB = Workbooks.Open(Pfad & Dateixls)
        
        'Wieder speichern mit Zusatzoptionen 
        WB.SaveAs Filename:=Pfad & Dateixls, FileFormat:=xlExcel8, _
            Password:="AAA", WriteResPassword:="BBB"
        
        'Kopie wieder schließen 
        WB.Close
        
        '*** Fehlerbehandlung 
        Err.Clear
Fehler:
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub

LG UweD
Anzeige
AW: Datei beim Schließen an einen zweiten Ort speicher
14.01.2019 13:19:32
UweD
.DisplayAlerts = False vergessen
Option Explicit

Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim WB, Pfad As String, Dateixls As String, Ext As String
    On Error GoTo Fehler
    
    Cancel = True 'stoppt das aktuelle speichern 
    
    Pfad = "X:\Temp\Test\" 'mit \ am Ende 
    Ext = ".xls"
    Dateixls = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & Ext
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .DisplayAlerts = False
        
        'Original speichern 
        ThisWorkbook.Save
    
        'Kopie speichern 
        ThisWorkbook.SaveCopyAs Filename:=Pfad & Dateixls
        
        'Kopie öffnen 
        Set WB = Workbooks.Open(Pfad & Dateixls)
        
        'Wieder speichern mit Zusatzoptionen 
        WB.SaveAs Filename:=Pfad & Dateixls, FileFormat:=xlExcel8, _
            Password:="AAA", WriteResPassword:="BBB"
        
        'Kopie wieder schließen 
        WB.Close
        
        '*** Fehlerbehandlung 
        Err.Clear
Fehler:
        .EnableEvents = True
        .DisplayAlerts = True
    End With
    
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub

Anzeige
AW: Datei beim Schließen an einen ...
14.01.2019 13:25:57
Herbert
Hallo Uwe,
dann aber auch noch .ScreenUpdating = True! ;o)=)
Servus
.ScreenUpdating = ...
14.01.2019 13:41:22
UweD
wird automatisch wieder auf True gesetzt, wenn das makro durchgelaufen ist.
Also nicht notwendig
AW: .ScreenUpdating = ...
14.01.2019 13:47:15
Herbert
Im Ernst? Wieso muss das nicht zurückgesetzt werden und die anderen schon?
Servus
AW: .ScreenUpdating = ...
14.01.2019 14:18:33
UweD
hab sogar gerade festgestellt, daß die Alarme auch automatisch wieder True sind
Kannst mal testen
Sub Test() ' 2 mal durchlaufen lassen 

    With Application
        MsgBox "Screenupdating: " & .ScreenUpdating & vbLf & vbLf & _
               "Alerts: " & .DisplayAlerts & vbLf & vbLf & _
               "Events: " & .EnableEvents
        ' muss alles WAHR sein 
        
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    
        MsgBox "Screenupdating: " & .ScreenUpdating & vbLf & vbLf & _
               "Alerts: " & .DisplayAlerts & vbLf & vbLf & _
               "Events: " & .EnableEvents
         ' zum Test: muss jetzt FALSCH sein 
    
    End With
        
    'Beim nächsten Start fällt auf: 
    'Die ersten Beiden sind wieder WAHR 
    'Events sind weiter FALSCH 
End Sub

Sub onon()
    'Zum Wiedereinschalten 
    Application.EnableEvents = True
End Sub


Die Events sind automatisch erst nach ExcelNeustart wieder an
Anzeige
AW: .ScreenUpdating = ...
14.01.2019 15:35:42
Daniel
Hi
das automatische Rücksetzen auf einen bestimmten Wert bei Makroende gilt für alle Einstellungen, bei denen das direkte Arbeiten mit Excel nur mit einer einzigen Einstellungsoption funktioniert (du kannst nicht mit Excel arbeiten, wenn die Bildschirmaktualisierung ausgeschaltet ist, daher muss sie wieder aktiviert werden)
Das automatische Rücksetzen passiert überall dort, wo beim direkten Arbeiten eine ganz bestimmte Einstellung gesetzt sein muss.
überall dort, wo das direkte Arbeiten auch mit unterschiedlichen Einstellungsoptionen funktioniert (insbesondere bei denjenigen Optionen, die Anwender auch selbst verändern kann wie die Neuberechnung der Formeln), bleibt die zuletzt gesetzte Einstellung bei Makroende erhalten.
Daher sollte man als gewissenhafter Programmierer diese Eigenschaften nicht auf irgendeinen Wert einstellen, sondern immer auf denjenigen Wert, der eingestellt war als das Makro gestartet wurde.
Dazu muss man sich diesen Wert in einer Variablen merken.
(siehe dazu auch hier mit Codebeispiel: https://online-excel.de/excel/singsel_vba.php?f=79 )
Gruß Daniel
Anzeige
AW: Datei beim Schließen an einen zweiten Ort speicher
15.01.2019 08:19:47
Sascha
Vielen Dank für die Hilfe bis hierher.
Das speichern am zweiten Ort mit der richtigen Endung funktioniert jetzt problemlos.
Nur, wenn ich die Kopie öffen und wieder schließe, dann versucht Excel auch hier wieder an diesem zweiten Ort zu speichern, da das Makro ja noch enthalten ist. Das ganze wird dann mit einer Fehlermeldung "Zugriff nicht möglich" abgebrochen.
Kann ich verhindern, dass das Makro in der Kopie ebenfalls ausgeführt wird?
AW: Datei beim Schließen an einen zweiten Ort speicher
15.01.2019 09:05:15
UweD
Hallo nochmal
dann noch ein Zwischenschritt und erst die Makros löschen.
Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim WB, Pfad As String, Dateixls As String, Ext As String
    Dim vbc As Object
    On Error GoTo Fehler
    
    Cancel = True 'stoppt das aktuelle Speichern 
    
    Pfad = "X:\Temp\Test\" 'mit \ am Ende 
    Ext = ".xls"
    Dateixls = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, ".") - 1) & Ext
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .DisplayAlerts = False
        
        'Original speichern 
        ThisWorkbook.Save
    
        'Kopie speichern 
        ThisWorkbook.SaveCopyAs Filename:=Pfad & Dateixls
        
        'Kopie öffnen 
        Set WB = Workbooks.Open(Pfad & Dateixls)
        
        'Makros entfernen 
        With WB.VBProject
            For Each vbc In .VBComponents
                Select Case vbc.Type
                    Case 1, 2, 3: .VBComponents.Remove .VBComponents(vbc.Name)
                    Case 100
                        With vbc.CodeModule
                            .DeleteLines 1, .CountOfLines
                        End With
                End Select
            Next
        End With
        
        'Wieder speichern mit Zusatzoptionen 
        WB.SaveAs Filename:=Pfad & Dateixls, FileFormat:=xlExcel8, _
            Password:="AAA", WriteResPassword:="BBB"
        
        'Kopie wieder schließen 
        WB.Close
    End With
        
        '*** Fehlerbehandlung 
        Err.Clear
Fehler:
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & vbLf & Err.Description: Err.Clear
End Sub

LG UweD
Anzeige
AW: Datei beim Schließen an einen zweiten Ort speicher
15.01.2019 11:38:51
Sascha
Vielen Dank für die Hilfe, so funktioniert alles ohne Probleme.
LG Sascha Blumberg
Prima! Danke für die Rückmeldung. owT
15.01.2019 11:48:13
UweD

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige