Folgende Situation:

Ich möchte eine Excel Tabelle als PDF versenden. Der Empfänger kann keine Excel Dateien empfangen, jeder Anhang wird auf eine Seite .tif eingeschmolzen.

Daher müsste die Tabelle, wenn sie länger wird als eine Seite aufgeteilt werden. Der Druckbereich wird festgelegt durch die nichtleeren Zellen. Die Seiten werden bereits in einer Zelle im Excel-Sheet gezählt.

Wenn jemand eine zielführende Idee hat wäre ich sehr dankbar.

Der betreffende Codeteil sieht derzeit so aus:

   'Sheet kopieren
     Sheets("AACSC").Copy
         
    'Seitenlayout Seite DINA4 hoch + Druckbereich
        Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .PrintTitleRows = ""
        .PrintTitleColumns = ""
    End With
    Application.PrintCommunication = True
    ActiveSheet.PageSetup.PrintArea = Range("A1").Value
    Application.PrintCommunication = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.236220472440945)
        .RightMargin = Application.InchesToPoints(0.236220472440945)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        '.PrintComments = xlPrintNoComments
        'Testweise, um Druck der Kommentare zu verhindern, ausgetauscht gegen:
        .PrintComments = False
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = False
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    Application.PrintCommunication = True
    
     ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:=lw_pfad & Dateiname, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
        :=False, OpenAfterPublish:=False
    
       
    'MSGBox Emailversand
'    ActiveWorkbook.SaveAs lw_pfad & Dateiname

    MsgBox "ACHTUNG Email wird geöffnet" & Chr(13) & Chr(13) & "dann sind Änderungen möglich" & Chr(13) & Chr(13) & "BITTE NICHT AUF SENDEN KLICKEN" & Chr(13) & Chr(13) & "sondern gleichzeitig 'Alt' und 'Tab' und dann 'OK'", , "OK"

'Rem Emailversand
Dim MyOutApp As Object
Dim MyMessage As Object
Dim AWS As String
AWS = lw_pfad & Dateiname & ".pdf"
  Set MyOutApp = CreateObject("Outlook.Application")
    'Outlook Nachricht erstellen
    Set MyMessage = MyOutApp.CreateItem(0)
    With MyMessage
        'Empfänger
        .To = Empfänger
        'Betreff
        .Subject = Betreff
        .Attachments.Add AWS
        'Hier wird ein normaler Text erstellt
        .Body = "Mail für normalen Textempfang"
        'Hier wird eine HTML Mail erstellt
        .HTMLBody = Text
        
        'Hier wird die Mail nochmals angezeigt
        .Display
        
        MsgBox "Die Email wird unter " & lw_pfad & Dateiname_Mail & " gespeichert und gesendet", , "OK"
        
        'Rem Mail wird gespeichert
        .SaveAs lw_pfad & Dateiname_Mail
        'Hier wird die Mail gleich in den Postausgang gelegt und gesendet.
        .Send
End With