Supportnet / Forum / Tabellenkalkulation

Hallo. Was soll ich zwischen folgenden zwei Zeilen schreiben damit meine Mappe beim schließen automatisch "Schreibgeschützt" gesetzt wird? [b]Private Sub Workbook_BeforeClose(Cancel As Boolean) End Sub[/b] Danke MfG

Hallo,

leider kann ich dir hier nicht weiterhelfen, aber einen Ratschlag. Du hast schon mehrere Threads zu deinem Problem mit schreibgeschützten Tabelenblättern geschrieben, es wäre sinnvoll hier auch die Zusammenhänge herzustellen und vielleicht den alten Thread weiterzuführen

https://supportnet.de/threads/1285946


da so der Helfer die vorhandenen Lösungsansätze auch kennt und nicht nochmal bei Adam und Eva beginnt.

Gruß

Helmut

Hallo Helmut,

du hast Recht, nur das keiner auf die vorhandene Threads reagiert. Da dachte ich mir, ich könnte in einem neuen Thread das Problem etwas eingrenzen.

Der Schwerpunkt dieses Problems: Makro soll den Dateinamen selbst einlesen und einfügen in SetAttr "... ", vbReadOnly. Wie es geht, würde ich gerne wissen.

MfG

Hallo,

du bist echt "verwirrend" !


Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Dateiname
Dateiname = Application.GetSaveAsFilename
ActiveWorkbook.SaveAs Filename:=Dateiname, WriteResPassword:="DeinPasswort"
End Sub

Mit Schreibschutzpasswort, ansonsten ist der Schreibschutz ja sinnlos, da dieser einfach aufgehoben werden kann.

Gruss u. mach nicht so viele Beiträge auf. Das verwirrt nur u. man hat keinen Überblick mehr, was eigentlich Sache ist.

Servus Ahnan,

freut mich, dass du wieder da bist! Erstmal Danke, dass du dich bei mir gemeldet hast. Und zweitens, ich verstehe nicht ganz recht, was ich mit dem obigen Makro anstellen soll und wozu es gut ist. Ich verstehe es einfach nicht, und wo ich es einfügen will.

zu: "Mit Schreibschutzpasswort, ansonsten ist der Schreibschutz ja sinnlos, da dieser einfach aufgehoben werden kann."
Es ist so: das Passwort ist in diesr Mappe nur dafür da, damit der Benutzer aus versehen keine Formeln in gesperrten Zeilen löschen kann. Er darf aber den Blattschutz aufheben, wenn er Absicht hat, die Struktur zu ändern.

Und jetzt zum Thema dieses Threads. Vielleich kannst du mir da weiter helfen?

Schau dir den Code an:

Private Sub Workbook_Open()
Application.Dialogs(xlDialogSaveAs).Show

Also wenn eine schreibgeschützte Datei geöffnet, erscheint gleich das "Speichern unter"-Fenster. Der benutzer ist gezwungwngen unter anderem Namen zu speichern und wird weiter auch mit dieser neuen Datei arbeiten. Die erste Datei bleibt dabei unversehrt. Es ist genau das, was ich brauche! Nur eine Kleinigkeit fehlt noch: wenn der Benutzer diese neue Mappe schließt, dann soll sie automatisch schreibgeschützt gesetzt werden. Was soll ich zwischen folgenden zwei Zeilen schreiben damit meine Mappe beim schließen automatisch "Schreibgeschützt" gesetzt wird?

Private Sub Workbook_BeforeClose(Cancel As Boolean)


End Sub

MfG
riddik

PS: das mit dem Passwort war nur Schutz der einzelnen Tabellen gemeint und nicht der ganzen Datei

Hallo
Ich vermute, du möchtest den Blattschutz aktivieren, dann schreibe:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

Gruß piano

_{Es wäre nett, wenn Du ein Feedback abgeben könntest,}
<sup>ob der Lösungsvorschlag Dein Problem gelöst hat.
- probieren geht über studieren -</sup>

Hi piano,

nein, du hast mich falsch verstanden. ich möchte nicht die sheets schützen, sondern die gesamte datei Schreibgeschützt setzen. Also wenn ich
die mappe ganz schließe,
gehe ins Windows-Explorer rein,
finde im Ordner diese Excel-Datei,
klicke diese mit der rechten Maustaste an und
gehe auf Eigenschaften, dann soll dort das "Schreibgeschützt"-Feld schon aktiviert sein.


Das ist dafür gedacht, damit ich die Dateien schreibgeschützt nicht jedesmal extra im Explorer setzen soll!

Ein anderer Vorschlag unter diesen Aspekten vielleicht???

MfG
riddik

Hallo Ahnan,

wenndu schon mal da bist (und wenn du noch da bist), könntest du dir Thread "Formatieren gesperrter Zellen" anschauen. Antrag Nr. 10 von mir.

MfG
riddik

Also,

wenn du die Mappe "im Explorer schreibschützt", also mit deinem beschriebenen Haken, dann kann doch jeder diesen Haken auch wieder entfernen u. dann ist dein Schreibschutz wieder aufgehoben !
Wenn du den Schreibschutz so setzt, wie ich es vorgeschlagen habe, dann kannst du den Schreibschutz nur deaktivieren, wenn du das entsprechende Passwort dazu hast. Ich versteh den Sinn mit dem "Schreibschutz im Explorer" nicht. Der ist doch nutzlos.

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
ActiveWorkbook.SaveAs , WriteResPassword:="DeinPasswort"
End Sub

Gruss

ach soooo, allles klar.

ich möchte eigentlich nur, dass diese datei beim Speichern aus versehen nicht überschrieben wird.
Aber so, denke ich ist es noch besser, werde ich gleich ausprobieren.

Nicht böse sein, aber ich würde nichtdesotrotz gerne wissen, was man zwischen den beiden Zeilen schreiben soll, damit man dafür die Funktion SetAttr benutzen kann. Dass das Makro den neuen Namen selbst einliest und in diese Funktion einfügt.

MfG

Also:


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Datei
Datei = ActiveWorkbook.FullName
SetAttr Datei, vbReadOnly
End Sub

Gruss

Lieber Ahnan,

ich möchte wirklich auf keinen Fall "verwirrend" sein, aber die letzten Coden von dir, sind nicht das, wonach ich suche. Die Springmaus hat im Thread "Schreibgaschützt" schon richtig verstanden, was ich brauche. Bitte anschauen, vielleicht hilft es beim Verstehen meines Problems.

Nur dass man bei SetAttr immer den Dateinamen im Makro festablegen muss. Ich möchte aber, dass der Name vom Makro abgelesen wird.

Ich habe schon mit der "Methode des wissenschaftlichen Drückens(Probierens)" probiert:

SetAttr (ActiveWorkbook.Path)+"*.xls", vbReadOnly

Es ist natürlich jedem klar, dass dabei nichts rauskam.

PS: Ich habe gehört, es soll über eine Funktion mit Benutzen einer Variable und Parameter, mit ByVal oder ByRef. Aber das ist nicht meine Baustelle. Vielleicht versteht jemand was davon?

MfG
riddik

Hallo,

diese sinngemässe Zeile von dir:

SetAttr (ActiveWorkbook.Path)+"*.xls", vbReadOnly

ist exakt das, was ich dir in Antwort 11 vorgeschlagen habe:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Datei
ActiveWorkbook.Save
Datei = ActiveWorkbook.FullName
SetAttr Datei, vbReadOnly
End Sub

Die aktive Mappe wird vor dem Schliessen gespeichert und im Explorer "Schreibgeschützt" gesetzt. Genau das hast du mit "(ActiveWorkbook.Path)+"*.xls" versucht zu erreichen ! Und genau das passiert in meinem Code, zumindest in Excel2000 ! Bei den Excelversionen könnte es u.U. Unterschiede geben.

Gruss

Hallo Ahnan.

Danke, jetzt klapt es. Ich weiss nicht warum, aber vorhin ist es nicht gegangen.

Jentzt aber nur noch eine kleinichkeit: mit der Zeile

Application.Dialogs(xlDialogSaveAs).Show

rufe ich das SaveAs-Fenster auf wie kann ich diese Microsoft Excel Abfrage aufrufen ob die Änderungen in der aktuellen Mappe gespeichert werden sollen (du weisst ja was ich meine: die Abfrage die normaleweise vor dem Schließen kommt)?

Wird danach das SaveAs-Fenster beim "Ja" klicken automatisch aufgerufen? Wenn nicht, was soll ich dann noch dazu schreiben, damit es passiert?

Ich bin dir sehr verbunden.

MfG
riddik

Probiers mal so, Riddik:

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Datei, erg, erg1, Filename

erg = MsgBox("Möchten Sie vor dem Schliessen speichern ?", vbExclamation + vbYesNo, "Speichern ?")
If erg = vbYes Then
Filename = ActiveWorkbook.FullName & " Kopie"
erg1 = Application.GetSaveAsFilename(Filename, Title:="Speichern nur über Kopie möglich !")
If erg1 = False Then Exit Sub
ActiveWorkbook.SaveAs Filename:=erg1
Datei = ActiveWorkbook.FullName
SetAttr Datei, vbReadOnly
Application.Quit
Else
Application.DisplayAlerts = False
Application.Quit
End If

End Sub


Du möchtest, wenn ich es verstanden habe, eine Schreibgeschützte Datei (sozusagen als Vorlage), öffnen, dann arbeitet der Nutzer damit u. beim Schliessen soll der Speichern Unter-Dialog erscheinen. Nutzer sucht sich den Pfad u. den Dateinamen aus. Die dadurch neu entstandene Datei soll mit dem Haken bei Schreibgeschützt versehen werden. Das sollte mit obigem Code passieren.

Noch ein Tipp: Für dein Vorhaben solltest du dir mal "Mustervorlage" anschauen. Also deine Ur-Mappe als Mustervorlage speichern u. nicht als xls.

Gruss

Hallo Ahnan,

Danke dir wiedermal für den obigen Code. Jetzt (vielleicht) letzte Frage: Wie lautet der Ausdruck im Code für:

If "aktive/diese Mappe schon Schreibgeschützt ist" Then Exit Sub

???

Die Frage ist auch an alle anderen adressiert, die es wissen.

MfG Riddik

Hallo,


If ActiveWorkbook.ReadOnly = True Then
MsgBox "Schreibgeschützt"
End If

Gruss

Danke Ahnan.

Ich habe auch selbst mehrere Varianten ausprobiert und immer

If ActiveWorkbook.vbReadOnly = True Then

geschrieben. Na ja..

MfG riddik

Hallo Ahnan,

wie kann ich in If - Funktion gleich 2 Bedinungen setzen (UND oder ODER)?

Die Frage ist auch an alle anderen adressiert, die es wissen.

MfG Riddik

und noch ne Frage:
die Zeile

Application.Quit

schliesst kompletten Excel, ich möchte aber, dass nur die Mappe geschlossen wird, und Excel selbst bleibt erhalten/offen.

wie geht das?

mfg
riddik

Hallo,


If Range("A1").Value = 1 And Range("B1").Value = 1 Or Range("A2").Value = 1 Then
MsgBox "Bedingung erfüllt"
End If

Wenn A1 = 1 und B1 = 1 dann MsgBox
Oder A2 = 1 dann MsgBox
Wenn alle drei Bedingungen erfüllt sind kommt ebenfalls die Box.


ActiveWorkbook.Close

Gruss

Hallo Ahnan.

Ich möchte Dir wiedermal Danke schön sagen. Das hat mich weitergebracht.

Ich bin jetzt, wie ich es schon mal erwähnt habe, auf einer slbstständigen "vb-Erkundungs-Tour", und ich denke, wird noch einige Zeit vergehen, bis mir die Fragen ausgehen. Daher noch drei "kleine" Fragen:

Beim schließen einer Datei kommt eine Abfrage durch Makro "ob die Änderungen gespeichert werden sollen?" (Antwort: Nein), dann die Abfrage ebenfalls durch ein Makro "ob Datei schreobgeschützt werden soll?" (Antwort: Ja oder Nein egal), danach werden die Wünsche erfüllt und Mappe soll geschlossen werden. Aber dazwischen kommt noch eine lästige "sollen die änderungen gespeichert werden?"-Abfrage von Microsoft. Wie kann ich diese abstellen oder vermeiden?

Hier geht es um Sub Before_Close: Es müssen zuerst einige Operationen ausgeführt werden, danach wenn eine Bedingungung erfüllt ist soll die Mappe sofort geschlossen werden(die gelaufene Operationen sollen bestehen), wenn nicht dann läuft die Prozedur weiter. Wenn ich schreibe:

ActiveWorkbook.Close

dann fängt er von vorne Sub Before_Close und kommt in Konflikt mit den schon gelaufenen Operationen. Diese Wiederholung möchte ich vermeiden. Ich hoffe es ist klar, was ich meine.

Hier geht es um MsgBox :
Oben hast du es mir mit MsgBox gezeigt:
erg = MsgBox("Möchten Sie vor dem Schliessen speichern ?", vbExclamation + vbYesNo, "Speichern ?")
Ich möchte, dass da noch eine "Abbrechen"-Befehlsschaltfläche enthalten wird, die die Funktion hat, den Vorgang des Schliessens abbricht (mit möglicher Rückwirkung der schon gelaufenen Operationen).

Vielen Dank im Voraus MfG
riddik

Guten Morgen Riddik,

schon so früh aktiv ?!
Alle deine Ausführungen verstehe ich leider nicht !
Da musst du schon das komplette Makro, um das es geht, posten u. dann genau mitteilen, an welchen Stellen etwas geändert werden soll bzw. wo es hapert !

Das ist der Code, den ich dir schonmal gepostet habe, mit der Ergänzung des Abbrechen-Tasters u. dem Close-Ereignis der Mappe:

Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Datei, erg, erg1, Filename

erg = MsgBox("Möchten Sie vor dem Schliessen speichern ?", vbExclamation + vbYesNoCancel, "Speichern ?")
If erg = vbCancel Then
Cancel = True
Exit Sub
End If
If erg = vbYes Then
Filename = ActiveWorkbook.FullName & " Kopie"
erg1 = Application.GetSaveAsFilename(Filename, Title:="Speichern nur über Kopie möglich !")
If erg1 = False Then Exit Sub
ActiveWorkbook.SaveAs Filename:=erg1
Datei = ActiveWorkbook.FullName
SetAttr Datei, vbReadOnly
Application.Quit
Else
Application.DisplayAlerts = False
ActiveWorkbook.Close
End If
End Sub

Allerdings das mit der "Rückwirkung gelaufener Operationen" u. dem Konflikt gelaufener Operationen, verstehe ich nicht so ganz. Da muss ich schon das komplette Makro sehen.
Im übrigen kann man Microsoft-Boxen mit:

Application.DisplayAlerts = False

unterdrücken(siehe in meinen sämtlichen Codes bisher.

Gruss u. bei weiteren Fragen kann ich erst heute Abend wieder "einsteigen".

Morgen Ahnan,

Danke für Cancel

Mit der "Rückwirkung gelaufener Operationen" werde ich schon irgend wie hinbekommen. Nicht, dass ich den Code nicht rausrücken will, da ist eh alles von dir, nur ich möchte nicht dass du deine Zeit damit vergeudest, da ich ihn und was ich überhaupt möchte selber noch nicht ganz verstehe.

Aber doch noch eine Frage:
Ich möchte eine schreibgeschützte Datei überschreiben und wieder schreibgeschützt setzen. Dafuür muss ich erstmal schreibgeschütz aufheben. Wie lautet der Befehl dafür?

MfG
riddik

Und noch was:

Wie lautet der Code für ein MsgBox mit nur OK-Schaltfläche, beim Klicken auf welches der Makro weiterausgeführt werden soll? Also nur ein InfoBox mit OK-Schaltfläche(Wahrscheinlich irgen etwas mit "Break")

MfG
riddik

Hallo Ahnan!

wie gesagt ich möchte nicht, dass nach dem Speichern kompletter Excel geschlossen wird. Dann habe ich, so wie du oben schreibst, an dieser Stelle

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Datei, erg, erg1, Filename
erg = MsgBox("Möchten Sie vor dem Schliessen speichern ?", vbExclamation +
vbYesNoCancel, "Speichern ?")
If erg = vbCancel Then
Cancel = True
Exit Sub
End If
If erg = vbYes Then
Filename = ActiveWorkbook.FullName & " Kopie"
erg1 = Application.GetSaveAsFilename(Filename, Title:="Speichern nur über Kopie möglich !")
If erg1 = False Then Exit Sub
ActiveWorkbook.SaveAs Filename:=erg1
Datei = ActiveWorkbook.FullName
SetAttr Datei, vbReadOnly
Application.Quit
Else
Application.DisplayAlerts = False
ActiveWorkbook.Close
End If
End Sub

ActiveWorkbook.Close
geschrieben. So führt er aber Sub Before_Close dann ein zweites mal aus.

Was mache ich Falsch?

MfG
riddik

PS: wo bleibst du nur bloß? Ich habe schon Haufen unbeantworteter Fragen (Antwort24 und 25).

Hallo,

der Befehl zum Schreibschutz aufheben:

Dim Datei
Datei = ActiveWorkbook.FullName
SetAttr Datei, vbNormal

Allerdings müsste dann die Mappe geschlossen u. wieder geöffnet werden, da der Haken zwar bei "Schreibgeschützt" weg ist, aber dies erst Auswirkungen beim nächsten öffnen der Mappe hat.

Eine Box mit OK, bekommst du schon, wenn du einfach nur:

MsgBox "Irgendein Text !"
eingibst !
Da du hier ja keine andere Möglichkeit hast, als OK zu betätigen, gibt es keine Alternative als das Makro einfach untendran zu schreiben.
Bei Ya/Nein kannst du Bedingungen mitgeben.

Gruss

Hallo Ahnan

Gott sei dank, bist du wieder da. Danke für weitere Tips

Könntest du bitte noch Antwort 26 zwischen "Hallo Ahnan" und "MfG" unter die Lupe nehmen?

Warum wird Sub Before_Close doppelt ausgeführt? Was soll ich anders schreiben, damit es nicht passiert?

MfG
riddik

Hallo Riddik,

nur keine Panik ! Es gibt auch noch ein Leben ausserhalb von Excel !
Dein Code:

Option Explicit
Dim Bys As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim erg As Byte, Datei, erg1, Filename
If Bys = True Then Exit Sub

erg = MsgBox("Möchten Sie vor dem Schliessen speichern ?", vbExclamation + vbYesNoCancel, "Speichern ?", "", 0)
If erg = vbCancel Then
Cancel = True
Exit Sub
End If
If erg = vbYes Then
Bys = True
Filename = ActiveWorkbook.FullName & " Kopie"
erg1 = Application.GetSaveAsFilename(Filename, Title:="Speichern nur über Kopie möglich !")
If erg1 = False Then Exit Sub
ActiveWorkbook.SaveAs Filename:=erg1
Datei = ActiveWorkbook.FullName
SetAttr Datei, vbReadOnly
Application.Quit
Else
Bys = True
ActiveWorkbook.Close False
End If

End Sub

Diesen genau so übernehmen, dann sollte es "funzen" !

Gruss

ich habe jetztz das Application.DisplayAlerts = False. Diese Microsoftmeldung lasst trotzdem nicht nach. Ich glaube sie kommt nach Private Sub Workbook_BeforeClose(daher, denke ich, ist dieser Befehl ungültig) aber immer noch vor dem Schliessen. Hier ist der komplete Code:

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets("Konzept").Select
Range("A1").Select
Dim Datei, erg, erg1, erg2
erg = MsgBox("Möchten Sie vor dem Schliessen speichern ?", vbExclamation + vbYesNoCancel, "Speichern ?")
If erg = vbCancel Then
Cancel = True
Exit Sub
End If
If erg = vbNo Then
erg1 = MsgBox("Möchten Sie Schreibgeschützt setzen ?", vbExclamation + vbYesNoCancel, "Schreibgeschützt ?")
If erg1 = vbCancel Then
Cancel = True
Exit Sub
End If
If erg1 = vbNo Then
Call Menü_weg
Exit Sub
End If
If erg1 = vbYes Then
If ActiveWorkbook.ReadOnly = True Then
MsgBox "Diese Datei ist bereits schreibgeschützt!"
Call Menü_weg
Application.DisplayAlerts = False
End
End If
If ActiveWorkbook.ReadOnly = False Then
Datei = ActiveWorkbook.FullName
SetAttr Datei, vbReadOnly
Call Menü_weg
Exit Sub
Application.DisplayAlerts = False
End If
End If
End If
If erg = vbYes And ActiveWorkbook.ReadOnly = True Then
MsgBox "Diese Datei ist schreibgeschützt!" & Chr(10) & "Bitte unter anderem Namen speichern!"
Application.Dialogs(xlDialogSaveAs).Show
Call Schützen
ActiveWorkbook.Save
Else
Call Schützen
ActiveWorkbook.Save
End If
Datei = ActiveWorkbook.FullName
erg1 = MsgBox("Möchten Sie Schreibgeschützt setzen ?", vbExclamation + vbYesNoCancel, "Schreibgeschützt ?")
If erg1 = vbCancel Then
Cancel = True
Exit Sub
End If
If erg1 = vbNo Then
Call Menü_weg
Application.DisplayAlerts = False
End
End If
If erg1 = vbYes Then
SetAttr Datei, vbReadOnly
Call Menü_weg
Application.DisplayAlerts = False
End If
Application.DisplayAlerts = False
End Sub

Das problem taucht an mehreren Stellen auf. Was soll ich ändern?

MfffG
riddik

Also RIDDIK, dein letztes Makro mit sämtlichen Untermakros ist mir jetzt wirklich zu mühselig nachzubauen.
Meinen letzten Code hast du übrigens auch noch nicht mit eingebaut.
Wenn du mir die Mappe per Mail sendest, dann schaue ich mal drüber.
held1233aol.com

Gruss

natürlich:
held1233@aol.com

Lieber Ahnan,

ich habe den Code aus Antwort29 in eine leere Mappe zu Testen übernommen.

1) Nach dem Speichern schliesst er trotzdem komletten Windows.

2) Beim Abbrechen des Speichern-Dialogs schliesst er die Mappe, obwohl man mit dieser vielleicht noch arbeiten möchte.

Ich habe einige kleine Änderungen im Code vorgrnommen:

Option Explicit
Dim Bys As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim erg As Byte, Datei, erg1, Filename
If Bys = True Then Exit Sub
erg = MsgBox("Möchten Sie vor dem Schliessen speichern ?", vbExclamation + vbYesNoCancel, "Speichern ?", "", 0)
If erg = vbCancel Then
Cancel = True
Exit Sub
End If
If erg = vbYes Then
Filename = ActiveWorkbook.FullName & " Kopie"
erg1 = Application.GetSaveAsFilename(Filename, Title:="Speichern nur über Kopie möglich !")
If erg1 = False Then
Cancel = True
Exit Sub
End If
Bys = True
ActiveWorkbook.SaveAs Filename:=erg1
Datei = ActiveWorkbook.FullName
SetAttr Datei, vbReadOnly
Exit Sub
Else
Bys = True
ActiveWorkbook.Close False
End If
End Sub

In diesem Zustand funktioniert das Makro einwandfrei, so wie ich es mir vorgestellt habe.

An dieser Stelle Danke schön. Bei neuen Fragen diesbezüglich werde ich mich wieder melden, und Dnke nochmal.

MfG
RIDDIK

Lieber Ahnan,

ich habe den Code aus Antwort29 in eine leere Mappe zu Testen übernommen.

1) Nach dem Speichern schliesst er trotzdem komletten Windows.

2) Beim Abbrechen des Speichern-Dialogs schliesst er die Mappe, obwohl man mit dieser vielleicht noch arbeiten möchte.

Ich habe einige kleine Änderungen im Code vorgrnommen:

Option Explicit
Dim Bys As Boolean

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim erg As Byte, Datei, erg1, Filename
If Bys = True Then Exit Sub
erg = MsgBox("Möchten Sie vor dem Schliessen speichern ?", vbExclamation + vbYesNoCancel, "Speichern ?", "", 0)
If erg = vbCancel Then
Cancel = True
Exit Sub
End If
If erg = vbYes Then
Filename = ActiveWorkbook.FullName & " Kopie"
erg1 = Application.GetSaveAsFilename(Filename, Title:="Speichern nur über Kopie möglich !")
If erg1 = False Then
Cancel = True
Exit Sub
End If
Bys = True
ActiveWorkbook.SaveAs Filename:=erg1
Datei = ActiveWorkbook.FullName
SetAttr Datei, vbReadOnly
Exit Sub
Else
Bys = True
ActiveWorkbook.Close False
End If
End Sub

In diesem Zustand funktioniert das Makro einwandfrei, so wie ich es mir vorgestellt habe.

An dieser Stelle Danke schön. Bei neuen Fragen diesbezüglich werde ich mich wieder melden, und Danke nochmal.

MfG
RIDDIK

• schreiben
• Auf Pfeile schreiben
• Türkisch schreiben
• e-mail schreiben