Kopie Datei

Hallo zusammen, ich benötige eure Hilfe bei einem scheinbar simplen Problem.
Der nachfolgende Code funktioniert 1a hat aber nur ein Problem, dass man den Code mit der ESC taste unterbrechen kann.
Deswegen würde ich ihn gern umstricken, bekomme es aber irgendwie nicht gebacken.
Folgendes Szenarium:
Meine Datei "Firma.xlsm" soll beim Schließen eine abgespeckte Kopie bekommen. Heißt in der Kopie darf man nicht alles sehen. Ich habe das bis jetzt so gelösst, das bei Workbook open abgefragt wird wie heißt du und der Code ausgeführt wird. Wenn aber die ESC Taste lange gedrückt wird stirbt der Code und die Datei geht ungefiltert auf. Es können dann zwar keine internen Makros über Buttons gesteuert werden aber man sieht Sachen welche nicht jeder sehen soll (Datenschutz -. Krankenstand als Beispiel).
Wie binde ich die Befehle welche bei Workbook_open drinn stehen (also ausblenden der roten und grünen Felder) so ein dass sie beim Schließen und erstellen der Kopie ausgeführt werden.
Danke fürs drüberschauen Gruß Frank

Private Sub Workbook_Open()
Dim Zelle As Range
Dim Bereich As Range
Dim ws As Worksheet
On Error Resume Next
If ActiveWorkbook.Name = "Kopie.xlsm" Then
For Each ws In Worksheets
Select Case ws.Name
Case "A-Schicht", "B-Schicht", "C-Schicht", "D-Schicht", "E-Schicht"
Set Bereich = ws.Range("P12:NV140")
For Each Zelle In Bereich
If Zelle.Interior.ColorIndex = 4 Then ' grün
Zelle.Interior.ColorIndex = 0
Zelle.ClearContents
Zelle.ClearComments
End If
If Zelle.Interior.ColorIndex = 3 Then ' rot
Zelle.Interior.ColorIndex = 0
Zelle.ClearContents
Zelle.ClearComments
End If
Next
End Select
Next
End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.SaveAs "Q:\allgemein\Kopie.xlsm", WriteResPassword:="1234"
Application.DisplayAlerts = True
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Torsten,
danke für deinen schnellen Tipp. Ich möchte keine weitere Passwortafrage. Meine Datei wird ganz normal gespeichert (sicheres Laufwerk) + eine Kopie soll erstellt werden wo alle roten und grünen Zellen mit einmal weiß sind. Komplizierter als gedacht.
Code unterbrechen mit ESC funktioniert so drückt man ESC gleich zu Anfang - läuft der Code in Workbook_open gar nicht erst los - Datei geht nicht auf - soweit ok. wartet man aber zwei drei Sekunden und betätigt dann ESC ist der Code angelaufen - wird unterbrochen und die Datei geht auf. Hilfreich wenn man beim programmieren mistgebaut hat und an den Code wieder rankommen muss
Application.Onkey "(ESC)","" zuschalten mit Application.OnKey "(ESC)"
Gruß Frank

Dim DateinameKopie AS string DIN WB AS Workbook If ThisWorbook.name like "*Kopie*" then exit sub DateinameKopie = Replace(Thisworbook.Fullname, ".", " Kopie.") With Application .enableEvants = False .displayalerts = False Thisworkbook.savecopyas DateinameKopie .enableevents = true .displayalerts = True End with Set WB = Workbooks.open(DateinameKopie) For each sh in WB.worksheets Hier die bearbeitung Next WB.save WB.close

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread