Private Sub Excel_Ausgabe()
Dim exl As Object
Dim sheet As Object
Dim n As Single
 
n = 1
On Error Resume Next
4: ' Verweis auf die Excel-Applikation setzen
5: Set exl = GetObject(, "Excel.Application")
6: If Err.Number <> 0 Then
7: Set exl = CreateObject("Excel.Application")
8: blnRunning = False ' Excel läuft nicht
9: Else
10: blnRunning = True
11: End If
'erstellt Excel-Dokument
 
exl.Workbooks.Add
'Excel-Arbeitsmappe wird hinzugefügt
 
Set sheet = exl.Sheets.Add
sheet.Name = "Projektliste"
'Tabellenname wird hinzugefügt
 
 
 
DoEvents
Do Until Me.dataProjekte.Recordset.EOF
 
 
If n = 1 Then
    
 
    sheet.Cells(n, 1) = "Nr."
    sheet.Cells(n, 2) = "Firma"
    sheet.Cells(n, 3) = "Projektbezeichnung"
    sheet.Cells(n, 4) = "Anfrage Verkaufsregion / Bearbeiter im AZ"
    sheet.Cells(n, 5) = "Eingang Anfrage (Proj.)"
    sheet.Cells(n, 6) = "Aufgabenstellung"
    sheet.Cells(n, 7) = "Projektumfang"
    sheet.Cells(n, 8) = "Status Bearbeitung (Projektierung)"
    sheet.Cells(n, 9) = "Termin"
    sheet.Cells(n, 10) = "Status Vertrieb/AZ"
    sheet.Cells(n, 11) = "Bemerkung"
    sheet.Cells(n, 12) = "Bearbeiter"
    
 
 
 
  
    n = n + 1
    End If
    sheet.Cells.Borders.LineStyle = xlContinuous
    
'   sheet.Cells(n, 1).Interior.Color = &HFFFF80
'   sheet.Cells(n, 1).Font.Color = &HFF&
'   sheet.Cells(n, 1).Interior.Color = &HFFFF80
 
DoEvents
    
 
    
    sheet.Cells(n, 1) = Me.dataProjekte.Recordset.Fields("Nummer")
    DoEvents
 
    sheet.Cells(n, 2) = Me.dataProjekte.Recordset.Fields("Firma")
    DoEvents
    
    sheet.Cells(n, 3) = Me.dataProjekte.Recordset.Fields("Projekt_text")
    DoEvents
 
    sheet.Cells(n, 4) = Me.dataProjekte.Recordset.Fields("Anfrage_Verkaufsregion")
    DoEvents
 
    sheet.Cells(n, 5) = Me.dataProjekte.Recordset.Fields("Eingang_Anfrage")
    DoEvents
 
    sheet.Cells(n, 6) = Me.dataProjekte.Recordset.Fields("Aufgabenstellng")
    DoEvents
 
    sheet.Cells(n, 7) = Me.dataProjekte.Recordset.Fields("Projektumfang")
    DoEvents
 
    sheet.Cells(n, 8) = Me.dataProjekte.Recordset.Fields("Status_Bearbeitung")
    DoEvents
 
    sheet.Cells(n, 9) = Me.dataProjekte.Recordset.Fields("Termin")
    DoEvents
 
    sheet.Cells(n, 10) = Me.dataProjekte.Recordset.Fields("Status_Vertrieb")
    DoEvents
    
    sheet.Cells(n, 11) = Me.dataProjekte.Recordset.Fields("Bemerkung")
    DoEvents
 
    sheet.Cells(n, 12) = Me.dataProjekte.Recordset.Fields("Bearbeiter")
    DoEvents
n = n + 1
 
DoEvents
'Me.datafilme.Recordset.MoveNext
Me.dataProjekte.Recordset.MoveNext
DoEvents
Loop
    Rows("1").Select
 
 
 
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .IndentLevel = 0
        .ShrinkToFit = True
        .MergeCells = True
        .Font.Size = 10
    End With
    
 
    'Inhalt bestimmter Spalten zentrieren
   ' Columns("B:B").HorizontalAlignment = xlCenter
    'Columns("C:C").HorizontalAlignment = xlCenter
    
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
 
 
    Selection.Font.Bold = True
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$1"
        .PrintTitleColumns = ""
        
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = "PROJEKTLISTE - Mittel- und Großmaschinen"
        .CenterHeader = "" '&D &T
        .RightHeader = ""
        .LeftFooter = "Seite: &P"
        .CenterFooter = "ksc:Schmidkte, rgo:Gotzig, ama:Mai, kra:Rahnhöfer, gse:Seibold, adiistler, fsc:Schuster, tsc:Schnauffer"
        .RightFooter = "Projektliste 2002.xls"
        .LeftMargin = Application.InchesToPoints(0.078740157480315)
        .RightMargin = Application.InchesToPoints(0.078740157480315)
        .TopMargin = Application.InchesToPoints(0.984251968503937)
        .BottomMargin = Application.InchesToPoints(0.984251968503937)
        .HeaderMargin = Application.InchesToPoints(0.511811023622047)
        .FooterMargin = Application.InchesToPoints(0.511811023622047)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 1200
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
    End With
 
exl.Visible = True
 
End Sub