Public Sub MakeReport(Monat As String, AnfDatum As Date, EndeDatum As Date, _
  Datei As String, Lis() As String)
    Dim Kal As clsKal
    Dim ExcelApp As Excel.Application
    Dim Wb As Workbook, WbNeu As Workbook
    Dim Ws As Worksheet, WsNeu As Worksheet
    Dim Index As Integer, Zeile As Integer, WertAnfang As Integer, Anfang As _
      Integer, Ende As Integer, ZeileSumme As Integer, AnzWert As Integer
    Dim Spalte As typSpIndex, SpDatum  As typSpIndex, SpBeschreibung     As _
    typSpIndex, SpZeit   As typSpIndex
    Dim SpGleitzeit   As typSpIndex, SpSaldoZeit   As typSpIndex, _
    SpSaldoGleitzeit As typSpIndex
    Dim Rng As Range
    Dim CellStr1 As String, CellStr2 As String, Wert As String, AltWert As _
      String
    Dim Werte() As typWert
 
    Set Kal = New clsKal
    AnfDatum = "1.10.2001"
    EndeDatum = "30.9.2002"
    Kal.InitKal AnfDatum, EndeDatum
    SetSpIndex
    Set ExcelApp = New Excel.Application
 
    Set Wb = ExcelApp.Workbooks.Open(Datei)
    Set Ws = Wb.Worksheets.Item(Monat)
    MsgBox CStr(Ws.Cells.SpecialCells(xlCellTypeLastCell).Address)
    MsgBox CStr(Ws.Cells.SpecialCells(xlCellTypeLastCell).Row)
 
    SpDatum = GetSpalte("Datum")
    SpBeschreibung = GetSpalte("Beschr")
    SpZeit = GetSpalte("Zeit")
    SpGleitzeit = GetSpalte("Gleitzeit")
    SpSaldoZeit = GetSpalte("SaldoZeit")
    SpSaldoGleitzeit = GetSpalte("SaldoGleitZeit")
    Anfang = 3
    For Zeile = Anfang To 6500
        If Ws.Cells(Zeile, SpDatum.Spalte) = "Summe" Then
            Ende = Zeile - 2
            ZeileSumme = Zeile
            Exit For
        End If
    Next Zeile
    Set WbNeu = ExcelApp.Workbooks.Add
    If WbNeu.Worksheets.Count > 0 Then Set WsNeu = WbNeu.Worksheets.Item(1)
    CellStr1 = SpalteBuch(SpDatum.Spalte) + "1"
    CellStr2 = SpalteBuch(SpSaldoZeit.Spalte) + CStr(ZeileSumme)
    Set Rng = Ws.Range(CellStr1 + ":" + CellStr2)
    Rng.Copy
    WsNeu.Paste
    CellStr1 = SpalteBuch(SpDatum.Spalte) + "2"
    CellStr2 = SpalteBuch(SpSaldoZeit.Spalte) + CStr(Ende)
    Set Rng = WsNeu.Range(CellStr1 + ":" + CellStr2)
    Rng.Sort WsNeu.Columns(SpBeschreibung.Spalte), xlAscending, , , , , , xlNo
    WertAnfang = SpDatum.Spalte + 2
    For Zeile = SpDatum.Spalte + 2 To Ende + 1
        If Not (Wert = "") Then AltWert = Wert
        Wert = WsNeu.Cells(Zeile, SpBeschreibung.Spalte)
        If Not (Wert = AltWert) And Not (AltWert = "") Then
            WsNeu.Rows(Zeile).Insert
            WsNeu.Cells(Zeile, SpZeit.Spalte).Formula = "=SUM(" + SpalteBuch( _
              SpZeit.Spalte) + "$" + _
            CStr(WertAnfang - 1) + ":" + SpalteBuch(SpZeit.Spalte) + "$" + CStr( _
            Zeile - 1) + ")"
            If Not (WsNeu.Cells(Zeile, SpZeit.Spalte) = 0) Then
                ReDim Preserve Werte(AnzWert + 1)
                Werte(AnzWert).Name = AltWert
                Werte(AnzWert).Wert = WsNeu.Cells(Zeile, SpZeit.Spalte)
                AnzWert = AnzWert + 1
            End If
            WertAnfang = Zeile + 2
        End If
    Next Zeile
    CellStr1 = SpalteBuch(SpDatum.Spalte) + "1"
    CellStr2 = SpalteBuch(SpSaldoZeit.Spalte) + CStr(2000)
    Set Rng = WsNeu.Range(CellStr1 + ":" + CellStr2)
    Rng.Clear
    Set Rng = WsNeu.Range("A1")
    Rng.Select
    WsNeu.Cells(1, 1) = "Projekt"
    WsNeu.Cells(1, 2) = "Summe für " + Monat
    For Zeile = 0 To UBound(Werte()) - 1
        WsNeu.Cells(Zeile + 2, 1) = Werte(Zeile).Name
        WsNeu.Cells(Zeile + 2, 2) = Werte(Zeile).Wert
    Next Zeile
    Zeile = Zeile + 3
    WsNeu.Cells(Zeile, 1) = "Stunden für " + Monat
    WsNeu.Cells(Zeile, 2) = Ws.Cells(ZeileSumme, SpZeit.Spalte)
    Zeile = Zeile + 2
    WsNeu.Cells(Zeile, 1) = "Gleitzeit genommen für " + Monat
    WsNeu.Cells(Zeile, 2) = Ws.Cells(ZeileSumme, SpGleitzeit.Spalte)
     Zeile = Zeile + 2
    WsNeu.Cells(Zeile, 1) = "Saldo Zeit Geschäftsjahr"
    WsNeu.Cells(Zeile, 2) = Ws.Cells(ZeileSumme, SpSaldoZeit.Spalte)
    Zeile = Zeile + 2
    WsNeu.Cells(Zeile, 1) = "Saldo Gleitzeit Geschäftsjahr"
    WsNeu.Cells(Zeile, 2) = Ws.Cells(ZeileSumme, SpSaldoGleitzeit.Spalte)
    WsNeu.Columns.AutoFit
    WbNeu.SendMail Lis, "Stunden für " + Monat
    WbNeu.Saved = True
    WbNeu.Close
    Wb.Close
    ExcelApp.Quit
End Sub

NS