Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1120to1124
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

Formatierung f. Druckbereich als neue Arbeitsmappe

Formatierung f. Druckbereich als neue Arbeitsmappe
Rainer
Hallo,
möchte aus einer Tabelle ein Arbeitsblatt kopieren und in einem Verzeichnis zum versenden speichern.
Dabei habe ich zwei weselntliche Punkte zu beachten:
  • Zum einen enthält das zu versendende Blatt im Bereich A-E Inhalte, welche das neue Blatt nicht enthalten soll

  • Zum anderen hat der zu versendende Bereich Inhalte, welche sich aus anderen Arbeitsblättern ergeben.

  • Als idealste Lösung habe ich derzeit einen Code, welcher mir den Druckbereich kopiert und in einem neuen Arbeitsblatt speichert.
    Das Problem hier: Der Inhalt wird völlig ohne Formatierung in das neue Blatt übergeben.
    Sprich: keine Rahmen, keine Farben, falsche Spaltenbreite etc.
    Hat mir jemand einen Rat?
    Gruß Rainer
    AW: Formatierung f. Druckbereich als neue Arbeitsmappe
    01.12.2009 21:13:42
    Josef
    Hallo Rainer,
    vom Prinzip her, geht das z.B. so.
    Sub copyPrintArea()
      Dim objWb As Workbook, rng As Range
      
      With ThisWorkbook.Sheets("Tabelle3") 'Tabellenname anpassen!
        Set rng = .Range(.PageSetup.PrintArea)
      End With
      
      Set objWb = Workbooks.Add(xlWBATWorksheet)
      With objWb
        With .Sheets(1).Range("A1")
          rng.Copy
          .PasteSpecial -4104
          .PasteSpecial -4163
          .PasteSpecial -4122
          .PasteSpecial 8
        End With
        Application.CutCopyMode = False
        .SaveAs "E:\Temp\druckbereich.xls" 'Speicherpfad/Name - Anpassen!
        .Close
      End With
      
      Set objWb = Nothing
      Set rng = Nothing
    End Sub

    Gruß Sepp

    Anzeige
    AW: Formatierung f. Druckbereich als neue Arbeitsmappe
    01.12.2009 21:29:59
    Rainer
    Hallo Sepp,
    danke für Deine Hilfe.
    Habe nun eine Fehlermeldung (Für diese Aktion müssen alle verbundenen Zellen dieselbe Größe haben).
    Programm hält bei .PasteSpecial -4163
    Hoffe, dass es für alle Formatierungen ein ".PasteSpecial ####" gibt.
    Wenn ich da richtig liege, kann ich die Ziffern wo nachlesen?
    Gruß Rainer
    mit verb. Zellen kannst du es vergessen!
    01.12.2009 21:49:10
    Josef
    Hallo Rainer,
    {Boris} Statement über Verbundene Zellen: https://www.herber.de/forum/archiv/900to904/t902693.htm
    Wozu verbundene Zellen, die bringen nur Probleme.
    Alle xlPasteType-Werte kannst du in der Hilfe nachlesen. (Cursor auf .PasteSpecial setzen und F1 drücken)
    Gruß Sepp

    Anzeige
    AW: Formatierung f. Druckbereich als neue Arbeitsmappe
    01.12.2009 21:53:29
    Rainer
    Hallo Sepp,
    eine Idee habe ich noch.
    Könnte man nicht vom ausgewählten Arbeitsblatt eine Kopie machen, die Inhalte dann leeren und dann in dieses neue Arbeitsblatt die Inhalte einfügen?
    Beispiel:
    Arbeitsblätter: [ Erfassung│Plan1│Plan2│Plan3│Plan4│PlanCopy ]
    Wenn nun Plan2 versendet werden soll folglich
    Plan2 kopieren und als PlanCopy wieder anlegen/überschreiben
    PlanCopy Inhalte löschen
    Plan2 kopieren und Inhalte in PlanCopy einfügen
    PlanCopy "speichern unter ... C:\Temp\"
    PlanCopy C:\Temp\ vesenden
    Könnte das so funktionieren?
    Gruß Rainer
    AW: Formatierung f. Druckbereich als neue Arbeitsmappe
    01.12.2009 22:12:34
    Josef
    Hallo Rainer,
    auch wenn du meinen Hinweis auf die verbundenen Zellen ignorierst, sie werden dich einholen;-))
    Probier's so.
    Sub copyPrintArea2()
      Dim objWb As Workbook, rng As Range, rngC As Range, rngDel As Range
      
      ActiveSheet.Copy
      Set objWb = ActiveWorkbook
      With objWb
        With .Sheets(1)
          .UsedRange = .UsedRange.Value
          Set rng = .Range(.PageSetup.PrintArea)
          For Each rngC In .UsedRange.Columns
            If Intersect(rngC, rng) Is Nothing Then
              If rngDel Is Nothing Then
                Set rngDel = rngC.EntireColumn
              Else
                Set rngDel = Union(rngDel, rngC.EntireColumn)
              End If
            End If
          Next
          If Not rngDel Is Nothing Then rngDel.Delete
          Set rngDel = Nothing
          For Each rngC In .UsedRange.Rows
            If Intersect(rngC, rng) Is Nothing Then
              If rngDel Is Nothing Then
                Set rngDel = rngC.EntireRow
              Else
                Set rngDel = Union(rngDel, rngC.EntireRow)
              End If
            End If
          Next
          If Not rngDel Is Nothing Then rngDel.Delete
          Set rngDel = Nothing
        End With
        .SaveAs "E:\Temp\Druckbereich.xls"
        .Close
      End With
      
      Set objWb = Nothing
      Set rng = Nothing
      Set rngDel = Nothing
      Set rngC = Nothing
    End Sub

    Gruß Sepp

    Anzeige
    AW: Formatierung f. Druckbereich als neue Arbeitsmappe
    01.12.2009 22:33:30
    Rainer
    Hallo Sepp,
    auch wenn du meinen Hinweis auf die verbundenen Zellen ignorierst, sie werden dich einholen;-))
    
    nicht ignoriert, wir hatten vermutlich zeitgleich geschrieben bzw. habe Deine Antwort erst nach dem Absenden gelesen.
    Dennoch danke für den zweiten Code, werde ich gleich mal testen.
    Ansonsten bleibt mir, den ausgewählten Bereich innerhalb der eMail unter zu bringen.
    Habe jedoch meine UserForm so gut wie fertig.
    Nun fehlt eben nur noch der Anhang des Arbeitsblattes.
    Sollte alles scheitern muss ich mal schauen, dass ich den Druckbereich noch irgendwie (zusätzlich zum Inhalt des Textfeldes) in die eMail dazu bekomme.
    Gruß Rainer
    Anzeige
    AW: Formatierung f. Druckbereich als neue Arbeitsmappe
    01.12.2009 22:49:33
    Rainer
    Hallo Sepp,
    nach der Mitteilung von vorher nenn ich aber das mal eine Glanzleistung.
    Formatierung der Zellen ist einwandfrei.
    Ne Kleinigkeit ist noch zu korrigieren (Ausblenden oder löschen der CommandButton's im neuen Sheet)
    Bekomme ich aber vermutlich hin.
    Für heute mache ich allerdings Schluß.
    Vielen Dank für Deine Hilfe und noch schönen Abend.
    Gruß Rainer

    Links zu Excel-Dialogen

    Beliebteste Forumthreads (12 Monate)

    Anzeige

    Beliebteste Forumthreads (12 Monate)

    Anzeige
    Anzeige
    Anzeige