Grafik u.Werte kopieren trotz Schutz u. verb.Zell.
23.02.2005 16:18:00
DonFiala
habe folgendes Problem, das mich seit heute Morgen die Zeit raubt!
Habe eine Tabelle mit Grafiken und Formeln. Diese wird aus der Datei raus kopiert und unter einem neuen Namen gespeichert.
Nun mein Problem:
Die Ursprungsdatei/Tabelle muss Ihren aktiven Blattschutz behalten!
Grafiken lassen sich aber nicht bei aktivem Blattschutz kopieren!
Also: ActiveSheet.Copy und dann in der Kopie ausschalten, das is auch in Ordnung. Nun werden beim kopieren auch die Grafiken erfasst!
Leider kann ich aufgrund verbundener Zellen etc nicht Werte einfügen!
Es klappt nur über eine Umweg wenn ich noch ein weiters Workbook einfüge!
Wenn ich beim Makroaufzeichnen kopiere und dann alles lösche, kann ich das kopierte nicht mehr einfügen, da es weg ist!
Was ebenfalls nicht klappt ist in der Ursprungsdatei den Blattschutz aufzuheben, dann zu kopieren und dann den Blattschutz wieder aufheben: Alle Formate sind flöten, incl. der Grafik!
Leider habe ich im Endergebnis dann drei Dateien! Die Original: o.k., die Enddatei: o.k. und leider die mittlere!
Wie krieg ich die weg? Problem die heisst einmal mappe1, dann mappe2, dann mappe3...
Ich hab auch schon probiert einfach in der ersten Datei die verküpfungen zu löschen (Makrorecorder), das klappt auch gut! Allerdings is dann das Problem, dass das nicht mehr funktioniert sobald sich der Pfad oder Dateiname ändert!
Könnte ich evtl. den Dateinamen schützen und den Pfad in einer Excel Zelle hinterlegen?
Das muss doch irgendwie möglich sein!
Hier mein bisheriges Makro:
Nach ewiger arbeit (Bis soo ne VBA Pfeife)
Ziel: Aus einer geschützen Mappe die geschützt bleiben soll ein Blatt mit Grafik rauskopieren und Werten und nicht Formel! Das muss doch zum Henker irgendwie gehen? BItte Bitte Biiittee helft mir, ich bin am verrückt werden! Ein ganzer Arbeitstag im A.....
Sub SpeichernuntermanuellemDatum()
ActiveSheet.Copy
ActiveSheet.Unprotect "Passwort"
Columns("D:K").Select
Selection.Copy
Workbooks.Add
Columns("D:D").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
Dim DName As String, Dateiname As String, Pfad As String
Pfad = Range("U2")
DName = Range("R2")
Dateiname = Pfad & "\" & DName & Format(Range("G3"), "YYYY.MMM") & ".xls"
' Tagesdatum als "Jahr.Monat.Tag" wegen Exploreransicht!
ActiveWorkbook.SaveAs Filename:=Dateiname
End Sub