Dim xlapp As Excel.Application
    Dim xlwb As Workbook
    Dim xlws As Worksheet
 
'Excelinstanz erstellen
    Set xlapp = New Excel.Application
    Set xlwb = xlapp.Workbooks.Add
 
'Blätter entfernen und erstes Blatt umbenennen
    xlapp.DisplayAlerts = False
    xlwb.Sheets(3).Delete
    xlwb.Sheets(2).Delete
    xlwb.Sheets(1).Name = "Anhang"
    Set xlws = xlwb.Worksheets("Anhang")
 
'Excel-Daten einfügen
 
	.
	.
	.
 
'Excelsheet formatieren
'~~~~~~~~~~~~~~~~~~~~~~   
    x = Form1.LV1.ListItems.Count
    For i = 3 To x - 1
        xlws.Columns(i).Columns.AutoFit
    Next i
    xlws.Columns("H:H").ColumnWidth = 11.5
 
'Überschriften formatieren
    Range(Cells(3, 1), Cells(3, 10)).Interior.Color = RGB(255, 255, 0)
    Range(Cells(3, 1), Cells(3, 10)).Font.Bold = True
    Range(Cells(3, 1), Cells(3, 10)).BorderAround , xlMedium, _
      xlColorIndexAutomatic
 
'1.Zeile formatieren
    Range(Cells(1, 1), Cells(1, 2)).Font.Bold = True
    Range("A1:C1").MergeCells = True
 
'Zeile Summe formatieren
    Range(Cells(x, 1), Cells(x, 10)).Font.Bold = True
 
'Druckbereich festlegen
    With xlws.PageSetup
        .RightHeader = Format(Date, "Dd.mm.yyyy")
        .LeftFooter = "&LFirmenname"
        .RightFooter = "&R Seite &P von &N"
        .LeftMargin = Application.InchesToPoints(0.787)
        .RightMargin = Application.InchesToPoints(0.787)
        .BottomMargin = Application.InchesToPoints(0.68)
        .TopMargin = Application.InchesToPoints(0.67)
        .HeaderMargin = Application.InchesToPoints(0.492)
        .FooterMargin = Application.InchesToPoints(0.492)
        .PrintHeadings = False
        .PrintGridlines = True
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .PrintTitleRows = "$1:$4"
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 90
    End With
 
'Exceldatei speichern
    xlwb.SaveAs DatName
    xlwb.Saved = True
 
'aufräumen
    xlwb.Close
    xlapp.Quit
    Set xlws = Nothing
    Set xlwb = Nothing
    Set xlapp = Nothing