?
Solved

Printing to printer contents from a record and all records of a table

Posted on 2003-03-18
10
Medium Priority
?
311 Views
Last Modified: 2010-04-07
I want to print a single record from a table in a database and I also require to print all records from a table in a database to the printer. How do I go about doing this please?
0
Comment
Question by:willgilmore
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 5
10 Comments
 
LVL 1

Expert Comment

by:GERTJAN
ID: 8161132
You can do something like this:

Put a commandbutton on a form named Command1
place a commadialog on the form named Commandialog1
Bind the record set to a table
Maybe you must adjust the  PrintText X-Coordinate ,       Y-Coordinate a little bit

Private Sub Command1_Click()
    Dim strSQL As String
    Dim Counter As Integer
    Dim Counter2 As Integer
    Dim intPages  As Integer
    Dim bDone As Boolean

    Set db = New Connection
    db.CursorLocation = adUseClient
    db.Open strProvider
    Set adoPrimaryRS = New Recordset
    strSQL = "select * from tablename"

    adoPrimaryRS.Open strSQL, db, adOpenStatic, adLockOptimistic
     
    intRecordCount = adoPrimaryRS.RecordCount
    If adoPrimaryRS.EOF Or adoPrimaryRS.BOF Then
        MsgBox "No records to print!", vbInformation
    Exit Sub
    End If
   
    intPages = Round(adoPrimaryRS.RecordCount / 63)
    If intPages < (adoPrimaryRS.RecordCount / 63) Then
    intPages = intPages + 1
    End If
    If intRecordCount <= 63 Then
        mnCurrentRow = intRecordCount
    Else
        mnCurrentRow = 63
    End If
    CommonDialog1.Flags = &H100000
    CommonDialog1.Flags = &H4
    CommonDialog1.Copies = 1
    CommonDialog1.FromPage = 1
    CommonDialog1.ToPage = intPages
    Dim nLoopCtr As Integer
    Dim sOutput(6)          As String
    Dim nScaleMode          As Integer
    Dim BeginPage, EndPage, NumCopies, i
    CommonDialog1.CancelError = True
    On Error GoTo ErrHandler
   
    CommonDialog1.ShowPrinter
    DoEvents
    MousePointer = vbHourglass
    DoEvents
    BeginPage = CommonDialog1.FromPage
    EndPage = CommonDialog1.ToPage
    NumCopies = CommonDialog1.Copies
    Counter = 1
    Counter2 = 1
    Printer.ScaleMode = vbMillimeters
    nScaleMode = Printer.ScaleMode
   
    printHead Counter2, intPages
   
    PrintFont "Arial", 10, False, False, False
    adoPrimaryRS.MoveFirst
    Do Until adoPrimaryRS.EOF
       
        sOutput(0) = adoPrimaryRS!FieldName1
        sOutput(1) = adoPrimaryRS!FieldName2
        sOutput(2) = adoPrimaryRS!FieldName3
        sOutput(3) = adoPrimaryRS!FieldName4
        sOutput(4) = adoPrimaryRS!FieldName5
        sOutput(5) = adoPrimaryRS!FieldName6
        PrintText 20, 24 + (Counter * 4), sOutput(0)
        PrintText 80, 24 + (Counter * 4), sOutput(1)
        PrintText 100, 24 + (Counter * 4), sOutput(2)
        PrintText 120, 24 + (Counter * 4), sOutput(3)
        PrintText 140, 24 + (Counter * 4), sOutput(4)
        PrintText 160, 24 + (Counter * 4), sOutput(5)
        'Printer.Line (2, 1 + ((nLoopCtr + 0.8) * 0.25))-(204, 1 + ((nLoopCtr + 0.8) * 0.25))
        'Printer.Line (1.75, 0.8)-(1.75, 1 + ((nLoopCtr + 0.8) * 0.25))
        'Printer.Line (2.55, 0.8)-(2.55, 1 + ((nLoopCtr + 0.8) * 0.25))
        'Printer.Line (3.55, 0.8)-(3.55, 1 + ((nLoopCtr + 0.8) * 0.25))
        'Printer.Line (5.2, 0.8)-(5.2, 1 + ((nLoopCtr + 0.8) * 0.25))
        'Printer.Line (5.9, 0.8)-(5.9, 1 + ((nLoopCtr + 0.8) * 0.25))
        'Printer.Line (7.15, 0.8)-(7.15, 1 + ((nLoopCtr + 0.8) * 0.25))
       
        adoPrimaryRS.MoveNext
        Counter = Counter + 1
       
        If Counter > mnCurrentRow Then
            If Counter2 < intPages Then
                Printer.Line (10, 24 + ((Counter * 4) + 1))-(191, 24 + ((Counter * 4) + 1))
                Printer.EndDoc
                Printer.ScaleMode = nScaleMode
                Counter2 = Counter2 + 1
                Counter = 1
                If adoPrimaryRS.RecordCount - adoPrimaryRS.AbsolutePosition <= 65 Then
                    mnCurrentRow = (adoPrimaryRS.RecordCount - adoPrimaryRS.AbsolutePosition) + 1
                Else
                    mnCurrentRow = 63
                End If
                printHead Counter2, intPages
            End If
        End If
       
    Loop
    Printer.Line (10, 24 + ((Counter * 4) + 1))-(191, 24 + ((Counter * 4) + 1))
    DoEvents
    Printer.EndDoc
    DoEvents
    Printer.ScaleMode = nScaleMode
End Sub

Private Sub printHead(PageNumber As Integer, PageTotal As Integer)
    'Printer.PaintPicture LoadPicture(App.Path & "\net.ico"), 80, 4, 13, 13
    PrintFont "Arial", 16, True, True, False
    PrintText 10, 4, "Name"
    PrintFont "Arial", 10, True, False, False
    PrintText 10, 15, "Date: " & Date
    Printer.Line (10, 20)-(191, 20)
    PrintText 160, 15, "Page " & PageNumber & " from " & PageTotal
    PrintFont "Arial", 10, False, False, False
    PrintText 20, 22, "FieldName1"
    PrintText 80, 22, "FieldName1"
    PrintText 100, 22, "FieldName1"
    PrintText 120, 22, "FieldName1"
    PrintText 140, 22, "FieldName1"
    PrintText 160, 22, "FieldName1"
End Sub

Private Sub PrintFont(sFontName As String, _
              nFontSize As Integer, _
              bFontBold As Boolean, _
              bFontItalic As Boolean, _
              bFontUnderline As Boolean)

Printer.FontSize = nFontSize
Printer.FontName = sFontName
Printer.FontSize = nFontSize
Printer.FontBold = bFontBold
Printer.FontItalic = bFontItalic
Printer.FontUnderline = bFontUnderline

End Sub

Private Sub PrintText(fXCoordinate As Single, _
              fYCoordinate As Single, _
              sText As String)


Dim lStart              As Integer
Dim lIndex              As Long

Printer.CurrentX = fXCoordinate
Printer.CurrentY = fYCoordinate

Do While lIndex <> 0
   
    Mid$(sText, lIndex, 2) = "  "
   
    lStart = lStart + lIndex
   
    lIndex = InStr(lStart, sText, vbCrLf)
Loop

Printer.Print sText

End Sub
0
 

Author Comment

by:willgilmore
ID: 8174102
I have an option to print current record, which will be the record I have currently displayed on the form and another option to print all records of this table.

Which option does the above code represent? Would you show this please?
0
 
LVL 1

Expert Comment

by:GERTJAN
ID: 8183002
You can use this for both. With the WHERE function of the SQL instruction you can increase your record set. If the record set has only one record, only that record would be printed. If the record set has more records, all the records would be printed in colums.

just try out the code

Gertjan
0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:willgilmore
ID: 8201854
I get the following error for the above code I have entered. Will you fix this and see if there are other errors in the code i have entered please.

I got the following error for the "For Set db = New Connection" statement of the code

Compile error
Invalid use of new keyword


Private Sub picPrintAllRec_Click()
Dim strSQL As String
Dim Counter As Integer
Dim Counter2 As Integer
Dim intPages  As Integer
Dim bDone As Boolean

Set db = New Connection
db.CursorLocation = adUseClient
db.Open strProvider
Set adoPrimaryRS = New Recordset
strSQL = "select * from STALLION"

adoPrimaryRS.Open strSQL, db, adOpenStatic, adLockOptimistic

intRecordCount = adoPrimaryRS.RecordCount
If adoPrimaryRS.EOF Or adoPrimaryRS.BOF Then
    MsgBox "No records to print!", vbInformation
    Exit Sub
End If

intPages = Round(adoPrimaryRS.RecordCount / 63)
If intPages < (adoPrimaryRS.RecordCount / 63) Then
    intPages = intPages + 1
End If

If intRecordCount <= 63 Then
    mnCurrentRow = intRecordCount
Else
    mnCurrentRow = 63
End If

CommonDialog1.Flags = &H100000
CommonDialog1.Flags = &H4
CommonDialog1.Copies = 1
CommonDialog1.FromPage = 1
CommonDialog1.ToPage = intPages
Dim nLoopCtr As Integer
Dim sOutput(6) As String
Dim nScaleMode As Integer
Dim BeginPage, EndPage, NumCopies, i
CommonDialog1.CancelError = True
On Error GoTo ErrHandler

CommonDialog1.ShowPrinter
DoEvents
MousePointer = vbHourglass
DoEvents
BeginPage = CommonDialog1.FromPage
EndPage = CommonDialog1.ToPage
NumCopies = CommonDialog1.Copies
Counter = 1
Counter2 = 1
Printer.ScaleMode = vbMillimeters
nScaleMode = Printer.ScaleMode

printHead Counter2, intPages

PrintFont "Arial", 10, False, False, False
adoPrimaryRS.MoveFirst
Do Until adoPrimaryRS.EOF
    sOutput(0) = adoPrimaryRS!FieldName1
    sOutput(1) = adoPrimaryRS!FieldName2
    sOutput(2) = adoPrimaryRS!FieldName3
    sOutput(3) = adoPrimaryRS!FieldName4
    sOutput(4) = adoPrimaryRS!FieldName5
    sOutput(5) = adoPrimaryRS!FieldName6
    PrintText 20, 24 + (Counter * 4), sOutput(0)
    PrintText 80, 24 + (Counter * 4), sOutput(1)
    PrintText 100, 24 + (Counter * 4), sOutput(2)
    PrintText 120, 24 + (Counter * 4), sOutput(3)
    PrintText 140, 24 + (Counter * 4), sOutput(4)
    PrintText 160, 24 + (Counter * 4), sOutput(5)
    'Printer.Line (2, 1 + ((nLoopCtr + 0.8) * 0.25))-(204, 1 + ((nLoopCtr + 0.8) * 0.25))
    'Printer.Line (1.75, 0.8)-(1.75, 1 + ((nLoopCtr + 0.8) * 0.25))
    'Printer.Line (2.55, 0.8)-(2.55, 1 + ((nLoopCtr + 0.8) * 0.25))
    'Printer.Line (3.55, 0.8)-(3.55, 1 + ((nLoopCtr + 0.8) * 0.25))
    'Printer.Line (5.2, 0.8)-(5.2, 1 + ((nLoopCtr + 0.8) * 0.25))
    'Printer.Line (5.9, 0.8)-(5.9, 1 + ((nLoopCtr + 0.8) * 0.25))
    'Printer.Line (7.15, 0.8)-(7.15, 1 + ((nLoopCtr + 0.8) * 0.25))
   
    adoPrimaryRS.MoveNext
    Counter = Counter + 1
    If Counter > mnCurrentRow Then
        If Counter2 < intPages Then
            Printer.Line (10, 24 + ((Counter * 4) + 1))-(191, 24 + ((Counter * 4) + 1))
            Printer.EndDoc
            Printer.ScaleMode = nScaleMode
            Counter2 = Counter2 + 1
            Counter = 1
            If adoPrimaryRS.RecordCount - adoPrimaryRS.AbsolutePosition <= 65 Then
                mnCurrentRow = (adoPrimaryRS.RecordCount - adoPrimaryRS.AbsolutePosition) + 1
            Else
                mnCurrentRow = 63
            End If
            printHead Counter2, intPages
        End If
    End If
   
Loop
Printer.Line (10, 24 + ((Counter * 4) + 1))-(191, 24 + ((Counter * 4) + 1))
DoEvents
Printer.EndDoc
DoEvents
Printer.ScaleMode = nScaleMode

End Sub
Private Sub printHead(PageNumber As Integer, PageTotal As Integer)
'Printer.PaintPicture LoadPicture(App.Path & "\net.ico"), 80, 4, 13, 13
PrintFont "Arial", 16, True, True, False
PrintText 10, 4, "Name"
PrintFont "Arial", 10, True, False, False
PrintText 10, 15, "Date: " & Date
Printer.Line (10, 20)-(191, 20)
PrintText 160, 15, "Page " & PageNumber & " from " & PageTotal
PrintFont "Arial", 10, False, False, False
PrintText 20, 22, "FieldName1"
PrintText 80, 22, "FieldName1"
PrintText 100, 22, "FieldName1"
PrintText 120, 22, "FieldName1"
PrintText 140, 22, "FieldName1"
PrintText 160, 22, "FieldName1"

End Sub
Private Sub PrintFont(sFontName As String, nFontSize As Integer, bFontBold As Boolean, bFontItalic As Boolean, bFontUnderline As Boolean)
Printer.FontSize = nFontSize
Printer.FontName = sFontName
Printer.FontSize = nFontSize
Printer.FontBold = bFontBold
Printer.FontItalic = bFontItalic
Printer.FontUnderline = bFontUnderline

End Sub
Private Sub PrintText(fXCoordinate As Single, fYCoordinate As Single, sText As String)
Dim lStart As Integer
Dim lIndex As Long

Printer.CurrentX = fXCoordinate
Printer.CurrentY = fYCoordinate

Do While lIndex <> 0
    Mid$(sText, lIndex, 2) = "  "
    lStart = lStart + lIndex
    lIndex = InStr(lStart, sText, vbCrLf)
Loop

Printer.Print sText

End Sub
0
 

Author Comment

by:willgilmore
ID: 8201928
I think the above code will work if I want to print all the records that exist in the table, which is what i want for the print all option on my form, but for my print current record - how does this work if im in a form on a record and i just want to print this record?
0
 
LVL 1

Expert Comment

by:GERTJAN
ID: 8204536

You had to add an reference in your project to the microsoft activex dataobjects 2.6 library. You can do that by clicking the menu project and then references. select the reference and click OK. On the line db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & "C:\Your.mdb;" you must give the path to your database. I asume that it is an acces MDB. Futher you must change Fieldname1 in a fieldname from your table STALLION. Then it must be working.

If you want to print just 1 record you can change the SQL instruction.

Example:
dim strName as string
strName = "Gertjan"
strSQL = "select * from STALLION WHERE Fieldname1 ='" & strName & "'"

Now we just have the records where in the field Fieldname1 stands Gertjan from the table STALLION. So if you just want 1 record then you must include in your table a field wich contain for each record an unique ID. Maybe you already have that.

I'll hope this explane something. If you still got some questions about this, please let me now.

Below is the new code.

Regards,

Gertjan

Dim db As ADODB.Connection
Private Sub picPrintAllRec_Click()

Dim strSQL As String
Dim Counter As Integer
Dim Counter2 As Integer
Dim intPages  As Integer
Dim bDone As Boolean

Set db = New Connection
db.CursorLocation = adUseClient
db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & "C:\Your.mdb;"
Set adoPrimaryRS = New Recordset
strSQL = "select * from STALLION"

adoPrimaryRS.Open strSQL, db, adOpenStatic, adLockOptimistic

intRecordCount = adoPrimaryRS.RecordCount
If adoPrimaryRS.EOF Or adoPrimaryRS.BOF Then
   MsgBox "No records to print!", vbInformation
   Exit Sub
End If

intPages = Round(adoPrimaryRS.RecordCount / 63)
If intPages < (adoPrimaryRS.RecordCount / 63) Then
   intPages = intPages + 1
End If

If intRecordCount <= 63 Then
   mnCurrentRow = intRecordCount
Else
   mnCurrentRow = 63
End If

CommonDialog1.Flags = &H100000
CommonDialog1.Flags = &H4
CommonDialog1.Copies = 1
CommonDialog1.FromPage = 1
CommonDialog1.ToPage = intPages
Dim nLoopCtr As Integer
Dim sOutput(6) As String
Dim nScaleMode As Integer
Dim BeginPage, EndPage, NumCopies, i
CommonDialog1.CancelError = True
On Error GoTo Errhandler

CommonDialog1.ShowPrinter
DoEvents
MousePointer = vbHourglass
DoEvents
BeginPage = CommonDialog1.FromPage
EndPage = CommonDialog1.ToPage
NumCopies = CommonDialog1.Copies
Counter = 1
Counter2 = 1
Printer.ScaleMode = vbMillimeters
nScaleMode = Printer.ScaleMode

printHead Counter2, intPages

PrintFont "Arial", 10, False, False, False
adoPrimaryRS.MoveFirst
Do Until adoPrimaryRS.EOF
   sOutput(0) = adoPrimaryRS!FieldName1 'replace FieldName1 after the ! for your fieldname from the table
   sOutput(1) = adoPrimaryRS!FieldName2
   sOutput(2) = adoPrimaryRS!FieldName3
   sOutput(3) = adoPrimaryRS!FieldName4
   sOutput(4) = adoPrimaryRS!FieldName5
   sOutput(5) = adoPrimaryRS!FieldName6
   PrintText 20, 24 + (Counter * 4), sOutput(0)
   PrintText 80, 24 + (Counter * 4), sOutput(1)
   PrintText 100, 24 + (Counter * 4), sOutput(2)
   PrintText 120, 24 + (Counter * 4), sOutput(3)
   PrintText 140, 24 + (Counter * 4), sOutput(4)
   PrintText 160, 24 + (Counter * 4), sOutput(5)
   'Printer.Line (2, 1 + ((nLoopCtr + 0.8) * 0.25))-(204, 1 + ((nLoopCtr + 0.8) * 0.25))
   'Printer.Line (1.75, 0.8)-(1.75, 1 + ((nLoopCtr + 0.8) * 0.25))
   'Printer.Line (2.55, 0.8)-(2.55, 1 + ((nLoopCtr + 0.8) * 0.25))
   'Printer.Line (3.55, 0.8)-(3.55, 1 + ((nLoopCtr + 0.8) * 0.25))
   'Printer.Line (5.2, 0.8)-(5.2, 1 + ((nLoopCtr + 0.8) * 0.25))
   'Printer.Line (5.9, 0.8)-(5.9, 1 + ((nLoopCtr + 0.8) * 0.25))
   'Printer.Line (7.15, 0.8)-(7.15, 1 + ((nLoopCtr + 0.8) * 0.25))
   
   adoPrimaryRS.MoveNext
   Counter = Counter + 1
   If Counter > mnCurrentRow Then
       If Counter2 < intPages Then
           Printer.Line (10, 24 + ((Counter * 4) + 1))-(191, 24 + ((Counter * 4) + 1))
           Printer.EndDoc
           Printer.ScaleMode = nScaleMode
           Counter2 = Counter2 + 1
           Counter = 1
           If adoPrimaryRS.RecordCount - adoPrimaryRS.AbsolutePosition <= 65 Then
               mnCurrentRow = (adoPrimaryRS.RecordCount - adoPrimaryRS.AbsolutePosition) + 1
           Else
               mnCurrentRow = 63
           End If
           printHead Counter2, intPages
       End If
   End If
   
Loop
Printer.Line (10, 24 + ((Counter * 4) + 1))-(191, 24 + ((Counter * 4) + 1))
DoEvents
Printer.EndDoc
DoEvents
Printer.ScaleMode = nScaleMode
Exit Sub
Errhandler:
End Sub
Private Sub printHead(PageNumber As Integer, PageTotal As Integer)
'Printer.PaintPicture LoadPicture(App.Path & "\net.ico"), 80, 4, 13, 13
PrintFont "Arial", 16, True, True, False
PrintText 10, 4, "Name"
PrintFont "Arial", 10, True, False, False
PrintText 10, 15, "Date: " & Date
Printer.Line (10, 20)-(191, 20)
PrintText 160, 15, "Page " & PageNumber & " from " & PageTotal
PrintFont "Arial", 10, False, False, False
PrintText 20, 22, "FieldName1"
PrintText 80, 22, "FieldName1"
PrintText 100, 22, "FieldName1"
PrintText 120, 22, "FieldName1"
PrintText 140, 22, "FieldName1"
PrintText 160, 22, "FieldName1"

End Sub
Private Sub PrintFont(sFontName As String, nFontSize As Integer, bFontBold As Boolean, bFontItalic As Boolean, bFontUnderline As Boolean)
Printer.FontSize = nFontSize
Printer.FontName = sFontName
Printer.FontSize = nFontSize
Printer.FontBold = bFontBold
Printer.FontItalic = bFontItalic
Printer.FontUnderline = bFontUnderline

End Sub
Private Sub PrintText(fXCoordinate As Single, fYCoordinate As Single, sText As String)
Dim lStart As Integer
Dim lIndex As Long

Printer.CurrentX = fXCoordinate
Printer.CurrentY = fYCoordinate

Do While lIndex <> 0
   Mid$(sText, lIndex, 2) = "  "
   lStart = lStart + lIndex
   lIndex = InStr(lStart, sText, vbCrLf)
Loop

Printer.Print sText

End Sub

0
 

Author Comment

by:willgilmore
ID: 8219064
Sorry - I have done all this & still get the following error for the above code I have entered. Will you fix this and see if there are other errors in the code i have entered please.

I got the following error for the "For Set db = New Connection" statement of the code

Compile error
Invalid use of new keyword
0
 
LVL 1

Expert Comment

by:GERTJAN
ID: 8220968
Did you add an reference in your project to the microsoft activex dataobjects 2.6 library?

Do you have also an reference in your project for the microsoft dao 3.51 or 3.6 object library?

the reference to the activex data object must stand above the dao reference.

I think you are using DAO to open the database. The code i posted is using ADODB to open the database.
If you don't want to use the activex data object (ADODB) then please post your code to open your database. Then i can place your code in the function.

Goodluck,

Gertjan
0
 

Author Comment

by:willgilmore
ID: 8228059
This now works but it doesnt work for the extra fields I put in, myabe I need to print to landscape, How do I do this. The code I have entered is shown below, what changes do i need to make to it:

Private Sub picPrintAllRec_Click()

Dim db As ADODB.Connection
Dim strSQL As String
Dim Counter As Integer
Dim Counter2 As Integer
Dim intPages  As Integer
Dim bDone As Boolean

Set db = New Connection
db.CursorLocation = adUseClient
db.Open "PROVIDER=Microsoft.Jet.OLEDB.4.0;Data Source=" & "C:\Forest View Stud Farm DBMS\Forest View Stud Farm.mdb;"
Set adoPrimaryRS = New Recordset
strSQL = "select * from STALLION"

adoPrimaryRS.Open strSQL, db, adOpenStatic, adLockOptimistic

intRecordCount = adoPrimaryRS.RecordCount
If adoPrimaryRS.EOF Or adoPrimaryRS.BOF Then
    MsgBox "No records to print!", vbInformation
    Exit Sub
End If

intPages = Round(adoPrimaryRS.RecordCount / 63)
If intPages < (adoPrimaryRS.RecordCount / 63) Then
    intPages = intPages + 1
End If

If intRecordCount <= 63 Then
    mnCurrentRow = intRecordCount
Else
    mnCurrentRow = 63
End If

CommonDialog1.Flags = &H100000
CommonDialog1.Flags = &H4
CommonDialog1.Copies = 1
CommonDialog1.FromPage = 1
CommonDialog1.ToPage = intPages
Dim nLoopCtr As Integer
Dim sOutput(6) As String
Dim nScaleMode As Integer
Dim BeginPage, EndPage, NumCopies, i
CommonDialog1.CancelError = True
On Error GoTo ErrHandler

CommonDialog1.ShowPrinter
DoEvents
MousePointer = vbHourglass
DoEvents
BeginPage = CommonDialog1.FromPage
EndPage = CommonDialog1.ToPage
NumCopies = CommonDialog1.Copies
Counter = 1
Counter2 = 1
Printer.ScaleMode = vbMillimeters
nScaleMode = Printer.ScaleMode

printHead Counter2, intPages

PrintFont "Arial", 10, False, False, False
adoPrimaryRS.MoveFirst
Do Until adoPrimaryRS.EOF
    sOutput(0) = adoPrimaryRS!StallionNumber 'replace FieldName1 after the ! for your fieldname from the table
    sOutput(1) = adoPrimaryRS!StableNumber
    sOutput(2) = adoPrimaryRS!Name
    sOutput(3) = adoPrimaryRS!Breed
    sOutput(4) = adoPrimaryRS!Colour
    sOutput(5) = adoPrimaryRS!Height
    sOutput(6) = adoPrimaryRS!Bone
    sOutput(7) = adoPrimaryRS!DateOfBirth
    sOutput(8) = adoPrimaryRS!Registered
    sOutput(9) = adoPrimaryRS!Fee
    sOutput(10) = adoPrimaryRS!SireNumber
    sOutput(11) = adoPrimaryRS!DamNumber
    sOutput(12) = adoPrimaryRS!AdditionalInformation
    sOutput(13) = adoPrimaryRS!EmployeeNumber
   
    PrintText 0, 24 + (Counter * 4), sOutput(0)
    PrintText 12, 24 + (Counter * 4), sOutput(1)
    PrintText 22, 24 + (Counter * 4), sOutput(2)
    PrintText 53, 24 + (Counter * 4), sOutput(3)
    PrintText 79, 24 + (Counter * 4), sOutput(4)
    PrintText 105, 24 + (Counter * 4), sOutput(5)
    PrintText 112, 24 + (Counter * 4), sOutput(6)
    PrintText 117, 24 + (Counter * 4), sOutput(7)
    PrintText 128, 24 + (Counter * 4), sOutput(8)
    PrintText 132, 24 + (Counter * 4), sOutput(9)
    PrintText 145, 24 + (Counter * 4), sOutput(10)
    PrintText 153, 24 + (Counter * 4), sOutput(11)
    PrintText 160, 24 + (Counter * 4), sOutput(12)
    PrintText 172, 24 + (Counter * 4), sOutput(13)
    'Printer.Line (2, 1 + ((nLoopCtr + 0.8) * 0.25))-(204, 1 + ((nLoopCtr + 0.8) * 0.25))
    'Printer.Line (1.75, 0.8)-(1.75, 1 + ((nLoopCtr + 0.8) * 0.25))
    'Printer.Line (2.55, 0.8)-(2.55, 1 + ((nLoopCtr + 0.8) * 0.25))
    'Printer.Line (3.55, 0.8)-(3.55, 1 + ((nLoopCtr + 0.8) * 0.25))
    'Printer.Line (5.2, 0.8)-(5.2, 1 + ((nLoopCtr + 0.8) * 0.25))
    'Printer.Line (5.9, 0.8)-(5.9, 1 + ((nLoopCtr + 0.8) * 0.25))
    'Printer.Line (7.15, 0.8)-(7.15, 1 + ((nLoopCtr + 0.8) * 0.25))
     
    adoPrimaryRS.MoveNext
    Counter = Counter + 1
    If Counter > mnCurrentRow Then
        If Counter2 < intPages Then
            Printer.Line (10, 24 + ((Counter * 4) + 1))-(191, 24 + ((Counter * 4) + 1))
            Printer.EndDoc
            Printer.ScaleMode = nScaleMode
            Counter2 = Counter2 + 1
            Counter = 1
            If adoPrimaryRS.RecordCount - adoPrimaryRS.AbsolutePosition <= 65 Then
                mnCurrentRow = (adoPrimaryRS.RecordCount - adoPrimaryRS.AbsolutePosition) + 1
            Else
                mnCurrentRow = 63
            End If
            printHead Counter2, intPages
        End If
    End If
Loop

Printer.Line (10, 24 + ((Counter * 4) + 1))-(191, 24 + ((Counter * 4) + 1))
DoEvents
Printer.EndDoc
DoEvents
Printer.ScaleMode = nScaleMode
Exit Sub
ErrHandler:

End Sub
Private Sub printHead(PageNumber As Integer, PageTotal As Integer)
'Printer.PaintPicture LoadPicture(App.Path & "\net.ico"), 80, 4, 13, 13
PrintFont "Arial", 16, True, True, False
PrintText 10, 4, "Name"
PrintFont "Arial", 10, True, False, False
PrintText 10, 15, "Date: " & Date
Printer.Line (10, 20)-(191, 20)
PrintText 160, 15, "Page " & PageNumber & " from " & PageTotal
PrintFont "Arial", 10, False, False, False
PrintText 0, 22, "Stallion No"
PrintText 12, 22, "Stable No"
PrintText 22, 22, "Name"
PrintText 53, 22, "Breed"
PrintText 79, 22, "Colour"
PrintText 105, 22, "Height"
PrintText 112, 22, "Bone"
PrintText 117, 22, "DOB"
PrintText 128, 22, "Reg"
PrintText 132, 22, "Fee"
PrintText 145, 22, "Sire No"
PrintText 153, 22, "Dam No"
PrintText 160, 22, "Employee No"
PrintText 172, 22, "Additional Info"

End Sub
Private Sub PrintFont(sFontName As String, nFontSize As Integer, bFontBold As Boolean, bFontItalic As Boolean, bFontUnderline As Boolean)
Printer.FontSize = nFontSize
Printer.FontName = sFontName
Printer.FontSize = nFontSize
Printer.FontBold = bFontBold
Printer.FontItalic = bFontItalic
Printer.FontUnderline = bFontUnderline

End Sub
Private Sub PrintText(fXCoordinate As Single, fYCoordinate As Single, sText As String)
Dim lStart As Integer
Dim lIndex As Long

Printer.CurrentX = fXCoordinate
Printer.CurrentY = fYCoordinate

Do While lIndex <> 0
    Mid$(sText, lIndex, 2) = "  "
    lStart = lStart + lIndex
    lIndex = InStr(lStart, sText, vbCrLf)
Loop

Printer.Print sText

End Sub
0
 
LVL 1

Accepted Solution

by:
GERTJAN earned 80 total points
ID: 8228712
first of all when you add fields you must change the line:

Dim sOutput(6) As String

You've got 14 fields so the line must be:

Dim sOutput(13) As String

If there are to many colums and it won't fit on the paper
you can print it landscape . Then you must add after the line:

Printer.ScaleMode = vbMillimeters

the line:

Printer.Orientation = vbPRORLandscape

Also you had to change the part:

If intRecordCount <= 63 Then
   mnCurrentRow = intRecordCount
Else
   mnCurrentRow = 63
End If

because there won't fit 63 lines on a page when you print landscape you can start at 25 and then see how many space there is left. You can try it out by adding 1 line each time untill you now how many lines there will fit on the page.

when you change the code above you must also change the following part of the code:

   If Counter > mnCurrentRow Then
       If Counter2 < intPages Then
           Printer.Line (10, 24 + ((Counter * 4) + 1))-(191, 24 + ((Counter * 4) + 1))
           Printer.EndDoc
           Printer.ScaleMode = nScaleMode
           Counter2 = Counter2 + 1
           Counter = 1
           If adoPrimaryRS.RecordCount - adoPrimaryRS.AbsolutePosition <= 65 Then
               mnCurrentRow = (adoPrimaryRS.RecordCount - adoPrimaryRS.AbsolutePosition) + 1
           Else
               mnCurrentRow = 63
           End If
           printHead Counter2, intPages
       End If
   End If

because this part will set the lines for the next page.
So if you set the first page to 25 lines then you must say in this part of the coding

adoPrimaryRS.AbsolutePosition <= 25 + 2 Then

and the line:

mnCurrentRow = 25


I'll hope that this clears some things for you.

Did you already figured out how you can increase your record set to just one record?

Goodluck,

Gertjan





0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Suggested Courses
Course of the Month12 days, 20 hours left to enroll

777 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question