Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
836to840
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
836to840
836to840
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Datei sichern

Datei sichern
19.01.2007 09:17:38
Odje.K
Hallo Excelfreunde !
Gibt es hierfür eine Lösung ?
Weißt jemand wie ich den Druckbereich im folgenden Makro einbinden kann?
Das Makro kopiert so wie es jetzt ist, das gesamte Arbeitsblatt, also auch die Druck-Buttons an der Seite umd meine Kommentare.

Sub sicherung()
With ThisWorkbook
.SaveCopyAs "D:\" & Left(.Name, Len(.Name) - 4) & _
Format(Now, "_DD.MM.YY_hhmmss") & ".xls"
End With
End Sub

Hat jemand eine Idee ob das geht und wenn ja - Wie ?
Einstweilen herzlichen Dank an alle, die sich für mich bemühen.
MfG Odje

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datei sichern
19.01.2007 11:43:30
fcs
Hallo Odje,
wenn du nur den Inhalt des Druckbereichs der Blätter in der Arbeitsmappe in einer Sicherungskopie speichern willst, dann muss du die Inhalte schrittweise in eine neue Arbeitsmappe übertragen.
Alternativ kannst du auch deine gespeicherte Sicherungskopie wieder per Makro öffnen und alle Inhalte die du nicht benötigst löschen und die Kopie wieder speichern.
Gruß
Franz

Sub sicherung()
Dim strDatName As String, wbKopie As Workbook
With ThisWorkbook
strDatName = "D:\" & Left(.Name, Len(.Name) - 4) & _
Format(Now, "_DD.MM.YY_hhmmss") & ".xls"
.SaveCopyAs strDatName
End With
Set wbKopie = Application.Workbooks.Open(Filename:=strDatName)
'... hier aufgezeichneten Code mit Löschaktionen in Kopie einfügen
'Beispiel
Sheets("Muster1").Select
ActiveSheet.Shapes("CommandButton1").Select
Selection.Delete
Columns("H:H").Select
Selection.ClearContents
Rows("1:3").Select
Selection.ClearContents
Range("A1").Select
'Sicherungskopie Speichern und schließen
wbKopie.Save
wbKopie.Close
End Sub
Sub sicherung_VarianteAlt()
'Für ältere Excelversionen
Dim wbThis As Workbook, wbSicherung As Workbook, I As Integer
Dim wksThis As Worksheet, wksSicherung As Worksheet, Bereich As Range, Zelle As Range
Set wbThis = ThisWorkbook
'Neue Mappe mit einer Tabelle anlegen
Set wbSicherung = Application.Workbooks.Add(xlWBATWorksheet)
'ggf. zusätzliche leere Blätter anlegen
For I = 2 To wbThis.Worksheets.Count
wbSicherung.Worksheets.Add After:=wbSicherung.Sheets(I - 1)
Next
For I = 1 To wbThis.Worksheets.Count
Set wksThis = wbThis.Worksheets(I)
Set wksSicherung = wbSicherung.Worksheets(I)
wksSicherung.Activate
'Tabellennamen in Sicherung übernehemn
wksSicherung.Name = wksThis.Name
If wksThis.PageSetup.PrintArea = "" Then 'kein Druckbereich festgelegt
Set Bereich = wksThis.UsedRange
Else
Set Bereich = wksThis.Range(wksThis.PageSetup.PrintArea)
End If
'Spaltenbreiten in Sicherung einstellen
For Each Zelle In wksThis.Range(Bereich.Cells(1, 1), Bereich.Cells(1, Bereich.Columns.Count))
wksSicherung.Columns(Zelle.Column - Bereich.Column + 1).ColumnWidth = Zelle.EntireColumn.ColumnWidth
Next
'Formate und Werte kopieren
Bereich.Copy
wksSicherung.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
wksSicherung.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
wksSicherung.Cells(1, 1).Select
Next
wbSicherung.SaveAs "D:\" & Left(wbThis.Name, Len(wbThis.Name) - 4) & _
Format(Now, "_DD.MM.YY_hhmmss") & ".xls"
End Sub
Sub sicherung_Variante2003()
'Für Excel 2003
Dim wbThis As Workbook, wbSicherung As Workbook, I As Integer
Dim wksThis As Worksheet, wksSicherung As Worksheet, Bereich As Range, Zelle As Range
Set wbThis = ThisWorkbook
'Neue Mappe mit einer Tabelle anlegen
Set wbSicherung = Application.Workbooks.Add(xlWBATWorksheet)
'ggf. zusätzliche leere Blätter anlegen
For I = 2 To wbThis.Worksheets.Count
wbSicherung.Worksheets.Add After:=wbSicherung.Sheets(I - 1)
Next
For I = 1 To wbThis.Worksheets.Count
Set wksThis = wbThis.Worksheets(I)
Set wksSicherung = wbSicherung.Worksheets(I)
wksSicherung.Activate
'Tabellennamen in Sicherung übernehemn
wksSicherung.Name = wksThis.Name
If wksThis.PageSetup.PrintArea = "" Then 'kein Druckbereich festgelegt
Set Bereich = wksThis.UsedRange
Else
Set Bereich = wksThis.Range(wksThis.PageSetup.PrintArea)
End If
'Formate und Werte kopieren
Bereich.Copy
wksSicherung.Cells(1, 1).PasteSpecial Paste:=xlPasteColumnWidths
wksSicherung.Cells(1, 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
wksSicherung.Cells(1, 1).Select
Next
wbSicherung.SaveAs "D:\" & Left(wbThis.Name, Len(wbThis.Name) - 4) & _
Format(Now, "_DD.MM.YY_hhmmss") & ".xls"
End Sub

Anzeige
AW: Datei sichern
19.01.2007 13:18:29
Odje.K
Hallo Franz
für deine Hilfe besten Dank.
Der Code "Sub sicherung_VarianteAlt()" passt.
Könnte man die Passage "ggf. zusätzliche leere Blätter anlegen" herausnehmen, da ich nur ein Tabellenblatt in der Sicherungsdatei benötige.
Ich habe es mal versucht aber ohne Erfolg.
Darf ich deine Hilfe noch mal in Anspruch nehmen !!
Gruß Odje
AW: Datei sichern
19.01.2007 14:24:27
fcs
Hallo Odje,
hier die abgespeckte Version
Gruß
Franz

Sub sicherung_VarianteAlt()
'Für ältere Excelversionen
Dim wbThis As Workbook, wbSicherung As Workbook, I As Integer
Dim wksThis As Worksheet, wksSicherung As Worksheet, Bereich As Range, Zelle As Range
Set wbThis = ThisWorkbook
'Neue Mappe mit einer Tabelle anlegen
Set wbSicherung = Application.Workbooks.Add(xlWBATWorksheet)
Set wksThis = wbThis.Worksheets(1) 'Hier ggf. die 1 ändern oder den Namen in Anführungszeichen
Set wksSicherung = wbSicherung.Worksheets(1)
wksSicherung.Activate
'Tabellennamen in Sicherung übernehemn
wksSicherung.Name = wksThis.Name
If wksThis.PageSetup.PrintArea = "" Then 'kein Druckbereich festgelegt
Set Bereich = wksThis.UsedRange
Else
Set Bereich = wksThis.Range(wksThis.PageSetup.PrintArea)
End If
'Spaltenbreiten in Sicherung einstellen
For Each Zelle In wksThis.Range(Bereich.Cells(1, 1), Bereich.Cells(1, Bereich.Columns.Count))
wksSicherung.Columns(Zelle.Column - Bereich.Column + 1).ColumnWidth = Zelle.EntireColumn.ColumnWidth
Next
'Formate und Werte kopieren
Bereich.Copy
wksSicherung.Cells(1, 1).PasteSpecial Paste:=xlPasteFormats
wksSicherung.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
wksSicherung.Cells(1, 1).Select
wbSicherung.SaveAs "D:\" & Left(wbThis.Name, Len(wbThis.Name) - 4) & _
Format(Now, "_DD.MM.YY_hhmmss") & ".xls"
End Sub

Anzeige
AW: Datei sichern
19.01.2007 15:21:32
Odje.K
Hallo Franz,
perfekt !!!!!
Danke
Gruß Odje

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige