• Home
 · 
• Databases/Data Access/DAO/ADO
 · 
• This function will property format and print a recordset. Printed rows are adjusted so that so that

This function will property format and print a recordset. Printed rows are adjusted so that so that

This function will property format and print a recordset. Printed rows are adjusted so that so that the fields will all fit horizontally on a

Rate This function will property format and print a recordset. Printed rows are adjusted so that so that

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

' Use .75 inch margins.
Const TOP_MARGIN = 1440 * 0.5
Const LEFT_MARGIN = 1440 * 0.75

Dim lCurrentPos As Long
Dim sCurrentField As String
Dim bChange() As Boolean
Dim iLongest As Integer
Dim lShorten As Long
Dim i As Integer
Dim x As Long
Dim lTotalHeaderLength As Long
Dim maxWidthPerLine As Long
Dim lLineWidth As Long
Dim maxFlengths() As Long
Dim fStartPos() As Long
Dim BM As Single
Dim numFields As Integer
Dim lFlengths() As Long
Dim sFNames() As String
Dim lFHeaderlenghts() As Long
Dim iNumToExpand As Integer
Dim PLines As Integer
Dim lCurrentY As Long
Dim Tlen As Integer
Dim LowY As Long

numFields = rs.Fields.Count - 1

ReDim lFlengths(numFields)
ReDim sFNames(numFields)
ReDim lFHeaderlenghts(numFields)
ReDim maxFlengths(numFields)
ReDim bChange(numFields)
ReDim fStartPos(numFields)
ReDim fEndPos(numFields)

'set bottom margin to an inch
BM = PRN.ScaleTop + PRN.ScaleHeight - 1440
maxWidthPerLine = PRN.Width - (LEFT_MARGIN * 2)
maxWidthPerLine = maxWidthPerLine - (100 * numFields)

For i = 0 To numFields
    sFNames(i) = rs.Fields(i).Name
'    maxFlengths(i) = PRN.TextWidth(sFNames(i)) + 100
    lFHeaderlenghts(i) = PRN.TextWidth(sFNames(i))
    lTotalHeaderLength = lTotalHeaderLength + lFHeaderlenghts(i)
Next

'get longest text in all fields
rs.MoveFirst
Do While rs.EOF <> True
    For i = 0 To numFields
        sCurrentField = rs(i)
        If PRN.TextWidth(sCurrentField) > maxFlengths(i) Then
            maxFlengths(i) = PRN.TextWidth(sCurrentField)
        End If
    Next i
    rs.MoveNext
Loop

For i = 0 To numFields
    If lFHeaderlenghts(i) > maxFlengths(i) Then
        lFlengths(i) = lFHeaderlenghts(i)
        bChange(i) = False
    Else
        lFlengths(i) = maxFlengths(i)
        bChange(i) = True
        iNumToExpand = iNumToExpand + 1
    End If
    lLineWidth = lLineWidth + lFlengths(i)
Next

'determine linewidths

Do While lLineWidth > maxWidthPerLine
    iLongest = 1
    For i = 0 To numFields
        If lFlengths(i) > lFlengths(iLongest) Then
            iLongest = i
        End If
    Next
    lShorten = 0.05 * (lFlengths(iLongest))
    lFlengths(iLongest) = lFlengths(iLongest) - lShorten
    lLineWidth = lLineWidth - lShorten

Loop



lCurrentPos = LEFT_MARGIN
For i = 0 To numFields
    
    fStartPos(i) = lCurrentPos
    If i <= numFields Then
        lCurrentPos = lCurrentPos + lFlengths(i) + 100
    End If
    
    Debug.Print CStr(fStartPos(i)) & "      " & CStr(lFlengths(i))
Next i

rs.MoveFirst

    Printer.CurrentX = TOP_MARGIN
    Printer.CurrentY = LEFT_MARGIN
    For i = 0 To numFields
        PRN.CurrentX = fStartPos(i)
        PRN.Print sFNames(i);
    Next i
    PRN.Print
    PRN.Line (LEFT_MARGIN, PRN.CurrentY)-(PRN.Width - LEFT_MARGIN, PRN.CurrentY)


Do While rs.EOF = False
    'print a line
        lCurrentY = PRN.CurrentY
        For i = 0 To numFields
            PRN.CurrentX = fStartPos(i)
            sCurrentField = rs.Fields(i) & ""
            If PRN.TextWidth(sCurrentField) > lFlengths(i) Then
                PRN.CurrentY = lCurrentY
                PLines = PRN.TextWidth(sCurrentField) \ lFlengths(i) + 1
                Tlen = Len(sCurrentField) / PLines
                PRN.Print Left(sCurrentField, Tlen);
                For x = 2 To PLines
                    PRN.Print
                    PRN.CurrentX = fStartPos(i)
                    PRN.Print Mid(sCurrentField, (x - 1) * Tlen + 1, Tlen);
                    If PRN.CurrentY > LowY Then
                        LowY = PRN.CurrentY
                    End If
                Next x
            
            Else
                PRN.CurrentY = lCurrentY
                PRN.Print sCurrentField;
                If PRN.CurrentY > LowY Then
                    LowY = PRN.CurrentY
                End If
            End If
        Next i
    If PRN.CurrentY >= BM Then
        ' Start a new page.
        
        PRN.NewPage
        PRN.CurrentY = TOP_MARGIN
        Printer.CurrentX = TOP_MARGIN
        Printer.CurrentY = LEFT_MARGIN
        LowY = PRN.CurrentY
        For i = 1 To numFields
            PRN.CurrentX = fStartPos(i)
            PRN.Print sFNames(i);
        Next i
        PRN.Print
        PRN.Line (LEFT_MARGIN, PRN.CurrentY)-(PRN.Width - LEFT_MARGIN, PRN.CurrentY)

    Else
        PRN.CurrentY = LowY
        PRN.Print
        PRN.Line (LEFT_MARGIN, PRN.CurrentY)-(PRN.Width - LEFT_MARGIN, PRN.CurrentY)
    End If
    rs.MoveNext
    
Loop

Printer.EndDoc

End Function