Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1052to1056
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

automatische Archivierung

automatische Archivierung
23.02.2009 16:50:47
Rüdiger
Hallo
ich schreibe mit Excel Rechnungen, die müssen archiviert werden, allerdings nicht die gesamte Tabelle sondern nur der Druckbereich des einzelnen Blattes:
Ich habe es vor Jahren mit dem Makro-Recorder hingekriegt, blicke aber durch den Code nicht mehr durch.
Heute hab ich es vesucht neu aufzuzeichnen:
ich kopiere den Druckbereich in die Zwischenablage,
öffne eine Tabelle, die nur ein leeres Blatt enthält,
Zwischenablage einfügen (jetzt sind alle Formatierungen weg....doof),
diese Datei speichern unter der Rechnungsnummer die in einer bestimmten Zelle steht,
die Hilfstabelle schließen.
Im Augenblick stoße ich mich daran, dass die Spaltenbreiten in der archivierten Datei nicht mehr so wie im Original sind.
Hilfe !
viele Grüsse
Rüdiger

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: automatische Archivierung
23.02.2009 16:55:30
Heinz
Hi,
Spaltenbreiten/Zeilenhöhen werden nur kopiert, wenn ganze Spalten/Zeilen referenziert werden,
wenn das nicht geht, Maße gesondert übertragen.
mfg Heinz
AW: automatische Archivierung
23.02.2009 18:05:54
Josef
Hallo Rüdiger,
pass den Code an und probier mal.
' **********************************************************************
' Modul: Modul2 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub exportPrintarea()
  Dim rng As Range
  Dim objWB As Workbook
  Dim strName As String, strPath As String
  
  
  On Error GoTo ErrExit
  GMS
  
  strPath = "E:\Office\Excel\Forum" 'Speicherpfad - Anpassen!
  
  If Right(strPath, 1) <> "\" Then strPath = strPath & "\"
  
  With Sheets("Tabelle1") 'zu exportierende Tabelle - Anpassen!
    Set rng = .Range("Print_Area")
    strName = .Range("A1").Text & ".xls" 'Zelle mit dem zu vergebenden Namen - Anpassen!
  End With
  
  
  Set objWB = Workbooks.Add(xlWBATWorksheet)
  
  rng.Copy
  With objWB.Sheets(1).Range("A1")
    .PasteSpecial -4163
    .PasteSpecial -4122
    .PasteSpecial 8
  End With
  Application.CutCopyMode = False
  
  objWB.SaveAs strPath & strName
  objWB.Close
  
  ErrExit:
  If Err.Number <> 0 Then MsgBox Err.Number & vbLf & Err.Description, vbExclamation, "Fehler"
  GMS True
  Set rng = Nothing
  Set objWB = Nothing
End Sub

Public Sub GMS(Optional ByVal Modus As Boolean = False)
  Static lngCalc As Long
  
  With Application
    .ScreenUpdating = Modus
    .EnableEvents = Modus
    .DisplayAlerts = Modus
    .EnableCancelKey = IIf(Modus, 1, 0)
    If Not Modus Then lngCalc = .Calculation
    If Modus And lngCalc = 0 Then lngCalc = -4105
    .Calculation = IIf(Modus, lngCalc, -4135)
    .Cursor = IIf(Modus, -4143, 2)
  End With
  
End Sub

Gruß Sepp

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige