Public Function GeneriereExcel(ByVal SelectString As String, _
                              ByRef ColumNames() As String, _
                              Optional ByVal Teilergebnis As Boolean = False)
Dim errObj As Error
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim strSumSelect As String
Dim eeFileName As String
Dim i As Long
Dim ExcelFileName As String
Dim intRecord As Integer
Dim MaxAnzahl As Double
 
' Start Excel
Screen.MousePointer = vbHourglass
 
On Error Resume Next
If IsNull(xlApp) Then
    Set xlApp = New Excel.Application 'los
Else
    xlApp.Quit
    Set xlApp = New Excel.Application 'nochmal neu
End If
 
On Error GoTo DataAccessError:
 
xlApp.Visible = False
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add
 
' Überschriften
For i = 0 To UBound(ColumNames)
    xlSheet.Cells(1, i + 1).value = ColumNames(i)
Next i
 
ExcelFileName = "SpeBass_Select.xls"
 
'Öffnet die Datenbankverbindung
OpenIt_AIM
 
sqlstring = SelectString
 
'initialisiert den Recordset
Set rs_AIM = conAdmin_AIM.OpenRecordset(sqlstring, dbOpenSnapshot)
If Not rs_AIM.EOF Then
    With rs_AIM
        intRecord = 2 ' zweite Zeile (erste ist Überschrift)
        Do While Not .EOF
            For i = 0 To UBound(ColumNames)
                xlSheet.Cells(intRecord, i + 1) = .Fields(ColumNames(i)).value
            Next i
 
        intRecord = intRecord + 1
        .MoveNext
        Loop
    End With
'Schliesst die Datenbankverbindung
    CloseIt_AIM
 
        ' Sheet formatieren
        xlSheet.Range("A1:P1").Font.Bold = True
        'xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(intRecord - 1, 
        ' 13)).Font.Size = 10
        'xlSheet.Range(xlSheet.Cells(1, 9), xlSheet.Cells(intRecord - 1, 
        ' 9)).NumberFormat = "#,##0.00"
       ' xlSheet.Range(xlSheet.Cells(1, 11), xlSheet.Cells(intRecord - 1, 
       ' 11)).NumberFormat = "#,##0.00"
        'xlSheet.Range(xlSheet.Cells(1, 12), xlSheet.Cells(intRecord - 1, 
        ' 12)).NumberFormat = "#,##0.00"
        'xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(intRecord - 1, 
        ' 13)).Columns.AutoFit
    '###############
    ' Teilergebnis
    If Teilergebnis = True Then
 
      xlSheet.Range("L4").Select ' Range kann irgendeine Zelle sein...denke ich
      xlApp.Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2, _
        12), _
      Replace:=True, PageBreaks:=False, SummaryBelowData:=True
      xlSheet.Range("L14").Select ' vielleicht kann man das auch weglassen
    End If
Else
  CloseIt_AIM
End If
 
    xlApp.Visible = True
    Screen.MousePointer = vbNormal
 
Exit Function
DataAccessError:
    MsgBox Err.Description
    For Each errObj In Errors
        Debug.Print errObj.Number, errObj.Description
    Next
    xlApp.Visible = True
    'Me.MousePointer = vbDefault
    Resume Next
End Function