Sub QuickSort(SortArray() As String, Optional ByVal varStart As Long, Optional _
  ByVal varEnd As Long)
   Dim i As Long, J As Long, RandIndex As Long, Partition As String
   Dim Low As Long, High As Long
 
   Low = IIf(varStart = 0, LBound(SortArray), varStart)
   High = IIf(varEnd = 0, UBound(SortArray), varEnd)
 
   If Low < High Then
      If High - Low = 1 Then
         If UCase(SortArray(Low)) > UCase(SortArray(High)) Then
            Swap SortArray(Low), SortArray(High)
         End If
      Else
         'Einen zufälligen Ausgangspunkt generieren
         RandIndex = Rnd() * (High - Low) + Low
         Swap SortArray(High), SortArray(RandIndex)
         Partition = UCase(SortArray(High))
         Do
            'Von beiden Seiten auf den Ausgangspunkt "zugehen"
            i = Low: J = High
            Do While (i < J) And (UCase(SortArray(i)) <= Partition)
               i = i + 1
            Loop
            Do While (J > i) And (UCase(SortArray(J)) >= Partition)
               J = J - 1
            Loop
 
            'Wenn der Ausgangspunkt noch nicht erreicht ist, sind 2 Elemente auf
            'beiden Seiten funktionsunfähig, deswegen werden sie vertauscht
            If i < J Then
               Swap SortArray(i), SortArray(J)
            End If
         Loop While i < J
 
         'Den Ausgangspunkt zu seinem richtigen Platz im Array führen
         Swap SortArray(i), SortArray(High)
 
         'Die QuickSort-Routine rekursiv nochmals aufrufen
         If (i - Low) < (High - i) Then
            QuickSort SortArray, Low, i - 1
            QuickSort SortArray, i + 1, High
         Else
            QuickSort SortArray, i + 1, High
            QuickSort SortArray, Low, i - 1
         End If
      End If
   End If
End Sub

Private Sub Swap(First As String, Second As String)
   Dim varTemp As String
 
   varTemp = First
   First = Second
   Second = varTemp
End Sub

Private Sub PrintElementsHeaderandFooting()
Call SetSql
Connect
RS.Open sql, CN
For Each X In RS.Fields
a = Split(X, "|")
If Not (X.Name = "ID" Or X.Name = "Area") Then
    If ((a(8) > Area1Top And a(8) < Area2Top) Or (a(8) > Area5Top And a( _
      8) < 30)) Then
        Printer.Font = a(4)
        Printer.FontBold = a(9)
        Printer.FontItalic = a(10)
        Printer.FontSize = a(5)
        Printer.FontUnderline = a(11)
        thetext = GetPrintText(X.Name, a(0), a(6))
        MyRect.left = (a(2) * Printer.ScaleWidth) / breite
        MyRect.Top = (a(8) * Printer.ScaleHeight) / höhe
        MyRect.Right = ((a(3) * Printer.ScaleWidth) / breite) + MyRect.left
        MyRect.Bottom = ((a(7) * Printer.ScaleHeight) / höhe) + MyRect.Top
        Printer.Print ""
                If a(1) = "0" Then
                Result = DrawText(Printer.hdc, thetext, Len(thetext), MyRect, _
                  DT_LEFT Or DT_WORDBREAK)
                ElseIf a(1) = "1" Then
                Result = DrawText(Printer.hdc, thetext, Len(thetext), MyRect, _
                  DT_RIGHT Or DT_WORDBREAK)
                Else
                Result = DrawText(Printer.hdc, thetext, Len(thetext), MyRect, _
                  DT_CENTER Or DT_WORDBREAK)
                End If
    End If
End If
Next
CLOSEN
End Sub