Druckbereiche von Tabellenblättern in neues Workbook kopieren

  • Excel

Es gibt 18 Antworten in diesem Thema. Der letzte Beitrag () ist von coolhand.

    Druckbereiche von Tabellenblättern in neues Workbook kopieren

    Hallo zusammen,

    ich wurde leider im Net und auch in diversen foren nicht fündig. Nun hier meine Fragen an Euch:

    Ich habe ein Workbook mit mehreren Sheets. Aus ausgewählten Sheets möchte ich jeweils die Druckbereiche als Excel workbook per email versenden.

    Wie ich das mache indem ich die ganzen Sheets versende, habe ich hinbekommen. Aber dass nur jeweils der Druckbereich kopiert und versendet wird, klappt irgendwie nicht.

    Mit .pagesetup.printarea habe ich bisher nur Fehlermeldungen erhalten.

    Es wäre super wenn jemand von euch einen Tip hätte!

    Mike

    Hier ist mein code:

    Quellcode

    1. Private Sub Button_versenden_Click()
    2. Dim FileExtStr As String
    3. Dim FileFormatNum As Long
    4. Dim Sourcewb As Workbook
    5. Dim Destwb As Workbook
    6. Dim TempFilePath As String
    7. Dim TempFileName As String
    8. Dim OutApp As Object
    9. Dim OutMail As Object
    10. Dim sh As Worksheet
    11. Dim TheActiveWindow As Window
    12. Dim TempWindow As Window
    13. With Application
    14. .ScreenUpdating = False
    15. .EnableEvents = False
    16. End With
    17. Set Sourcewb = ActiveWorkbook
    18. With Sourcewb
    19. Set TheActiveWindow = ActiveWindow
    20. Set TempWindow = .NewWindow
    21. TheActiveWindow.SelectedSheets.Copy
    22. End With
    23. With Destwb 'externe Verknüpfungen entfernen
    24. Dim Zelle As Range
    25. For Each Zelle In Worksheets(1).UsedRange
    26. If Left(Zelle.Formula, 1) = "=" And InStr(Zelle.Formula, "[") > 1 Then
    27. Zelle.Value = Zelle.Value
    28. End If
    29. Next Zelle
    30. End With
    31. TempWindow.Close
    32. Set Destwb = ActiveWorkbook
    33. 'Determine the Excel version and file extension/format
    34. With Destwb
    35. If Val(Application.Version) < 12 Then
    36. 'You use Excel 97-2003
    37. FileExtStr = ".xls": FileFormatNum = -4143
    38. Else
    39. 'You use Excel 2007-2013
    40. Select Case Sourcewb.FileFormat
    41. Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
    42. Case 52:
    43. If .HasVBProject Then
    44. FileExtStr = ".xlsm": FileFormatNum = 52
    45. Else
    46. FileExtStr = ".xlsx": FileFormatNum = 51
    47. End If
    48. Case 56: FileExtStr = ".xls": FileFormatNum = 56
    49. Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
    50. End Select
    51. End If
    52. End With
    53. TempFilePath = Environ$("temp") & "\"
    54. TempFileName = "Unterlagen " & Format(Now, "dd-mmm-yyyy hh-mm")
    55. Set OutApp = CreateObject("Outlook.Application")
    56. Set OutMail = OutApp.CreateItem(0)
    57. With Destwb
    58. .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
    59. On Error Resume Next
    60. With OutMail
    61. .To = ""
    62. .CC = ""
    63. .BCC = ""
    64. .Subject = "Unterlagen"
    65. .Body = "Siehe beiliegende Datei." & vbNewLine & .Signature
    66. .Attachments.Add Destwb.FullName
    67. .Display
    68. End With
    69. On Error GoTo 0
    70. .Close savechanges:=False
    71. End With
    72. Kill TempFilePath & TempFileName & FileExtStr
    73. Set OutMail = Nothing
    74. Set OutApp = Nothing
    75. With Application
    76. .ScreenUpdating = True
    77. .EnableEvents = True
    78. End With
    79. End Sub
    Die Adresse des Druckbereichs steht für jedes Sheet in PageSetup.Printarea.
    Wenn keine Druckbereich festgelegt ist, kannst du UsedRange verwenden.

    Visual Basic-Quellcode

    1. For Each ws in ThisWorkbook.Sheets
    2. pa = ws.PageSetup.Printarea
    3. if pa="" Then Set Rng=ws.UsedRange Else Set Rng=ws.Range(pa)
    4. Rng.Copy DestWB.Sheets(ws.Name).Range("A1")
    5. Next
    Der Code geht davon aus, dass im DestWB die Sheet-Struktur schon existiert, aber das kriegst du ja selbst hin.

    Ich würde ja einen völlig anderen Ansatz nehmen.
    Ich würde die Sheets in ein PDF exportieren und das PDF verschicken.

    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Danke schon mal für den Ansatz!
    Bin halt auch noch ein Anfänger, aber es geht vorwärts..
    Und mit Geduld von euch Experten komm ich dann auch mal ans ziel ;)

    Den Versand mit Pdf habe ich auch implementiert, gewisse User wollen halt ihre Sheets als Excel versenden, deshalb die Möglichkeit sowohl als auch.. (mittels Buttons in Userform).

    Leider funktioniert es bei mir nicht, oder ich habs nicht so umgesetzt wie von dir angedacht..
    zuerst meldete es mir ws sei nicht definiert, also hab ich "dim ws as Worksheet" definiert.
    Dann meldete es Variable "pa" sei nicht definiert. Da komm ich nun nicht weiter. Nach meinem Verständnis ist das ja eine "printarea". Ich kann "pa" aber nicht dazu definieren.. vermutlich mache ich da einen Überlegungsfehler..
    Möglicherweise variiert das zwischen Office-Versionen und Spracheinstellungen.
    Zeichne ein Macro auf, während du den Druckbereich definierst.
    Dann siehst du, welche Bereiche angesprochen werden.
    Oder nimm den Debugger und schau dir die Properties von PageSetup an.

    pa ist übrigens kein Range, sondern ein String, der die Adresse des Range enthält.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    petaod ;) ja ich hab das nuin so korrekt definiert.

    Quellcode

    1. Dim TheActiveWindow As Window
    2. Dim TempWindow As Window
    3. Dim ws As Worksheet
    4. Dim pa As String
    5. With Application
    6. .ScreenUpdating = False
    7. .EnableEvents = False
    8. End With
    9. Set Sourcewb = ActiveWorkbook
    10. With Sourcewb
    11. Set TheActiveWindow = ActiveWindow
    12. Set TempWindow = .NewWindow
    13. 'TheActiveWindow.SelectedSheets.Copy
    14. For Each ws In ThisWorkbook.Sheets
    15. pa = ws.PageSetup.PrintArea
    16. If pa = "" Then Set rng = ws.UsedRange Else Set ws.rng = ws.Range(pa)
    17. ws.rng.Copy Destwb.Sheets(ws.Name).Range("A1")
    18. Next
    19. End With



    und schon kommt der nächste Fehler..

    rng => "Variable nicht definiert".. oder wenn ich rng in Range abändere meldet es "Argument ist nicht optional"

    Btw: Hab ich das am richtigen Ort eingefügt? Ich weiss ist eine dumme Frage... bin mir aber nicht mehr so sicher aufgrund der Fehlermeldungen..
    Hmmm,.. jetzt hab ichs zum Laufen gebracht (unten ist der Code)
    ABER zum Einen kopiert es mir alle Tabellenblätter und nicht nur die selectedsheets (ich wollte dies bei "thisworkbook.sheets" in "thisworkbook.selectedsheets" abändern, dies geht jedoch nicht..)
    und zum Anderen kopiert es mir immer noch das Ganze Tabellenblatt und nicht nur den Druckbereich (!?), was ich ja so eigentlich gar nicht verstehe.. (es funktioniert also gleich wie "TheActiveWindow.Sheets.Copy"...)

    Quellcode

    1. Set Sourcewb = ActiveWorkbook
    2. With Sourcewb
    3. Set TheActiveWindow = ActiveWindow
    4. Set TempWindow = .NewWindow
    5. For Each ws In ThisWorkbook.Sheets
    6. pa = ws.PageSetup.PrintArea
    7. If pa = "" Then Set rng = ws.UsedRange Else: Set rng = ws.Range(pa)
    8. rng.Copy
    9. Next
    10. End With

    coolhand schrieb:

    "thisworkbook.selectedsheets"

    ThisWorkbook.Windows(1).SelectedSheets
    oder
    ActiveWindow.SelectedSheets


    coolhand schrieb:

    nicht nur den Druckbereich

    Was steht jeweils in ​ws.PageSetup.PrintArea drin?
    Nutze den Debugger!
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    mit selectedsheets funktionieren beide genannten Möglichkeiten auch nicht.. gibt mir zwar beim debuggen keinen Fehler an, kopiert aber immer noch alle Blätter.

    Aktuellen Wert anzeigen:
    Kontext: VBAProject.UserForm1.Button_versenden_Click
    Ausdruck: PrintArea
    Wert:<Ausserhalb des Kontexts>

    falls das die gewünschte Info ist..
    man lernt immer dazu - Danke für deine Geduld!

    Er gibt den Wert "$A$1:$N$63" an - dies entspricht auch dem Druckbereich dieses Blattes.

    jetzt habe ich aber festgestellt, dass in der nächsten Zeile der Wert von ws.usedrange und der Wert von ws.range(pa) leer bleiben..

    coolhand schrieb:

    If pa = "" Then Set rng = ws.UsedRange Else: Set rng = ws.Range(pa)

    1) Der Doppelpunkt nach Else ist unschön. Mach ihn raus
    2) Wenn du im Singlestep (F8) durchgehst, geht er in den If-Zweig oder in den Else-Zweig?
    (Lässt sich erkennen durch die gelb unterlegten Code-Teile)
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    1) Der Doppelpunkt nach Else ist unschön. Mach ihn raus - erledigt
    2) Wenn du im Singlestep (F8) durchgehst, geht er in den If-Zweig oder in den Else-Zweig? - er geht in den Else-Zweig. Die Kopiermarkierung und der Debugger zeigt dann auch den richtigen Bereich an... und trotzdem kopiert er mir das ganze Sheet..

    coolhand schrieb:

    If pa = "" Then Set rng = ws.UsedRange Else Set rng = ws.Range(pa)
    rng.Copy

    rng.Copy schiebt die Zellen ja nur in den PasteBuffer. Wie und wo fügst du sie wieder ein?

    Warum kopierst du nicht direkt in den Zielbereich, wie ich vorschlug?
    ​rng.Copy Destwb.Sheets(ws.Name).Range("A1")
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    zuerst ein gutes neues Jahr!

    dann zum Geschäftlichen ;)

    ich habe den Teil weggelassen, weil es dann mit kopieren funktioniert (ausser dem Druckbereichproblem)
    Lasse ich den Teil stehen bringt es mir immer wieder den Laufzeitfehler 91. Ich habe versucht den Bock zu finden, komme aber einfach nicht darauf..
    Also das mit dem Printarea kopieren hab ich nicht geschafft.. :(
    Nun hab ich es so programmiert, dass es mir die Sheets kopiert, dann die Spalten welche ich nicht benötige ausblende..
    Ist nicht ganz sauber, aber es funktioniert.

    Danke trotzdem für die Hilfe, hab zumindest wieder was gelernt ;)