Printing Problem

Posted on 2002-03-08
Medium Priority
Last Modified: 2012-08-14
Hi All!

I'm trying to print from a Recordset.  I cannot get the columns to line up correctly. Here's my code.  Any help is appreciated!

Private Sub cmdPrint_Click()
    Dim ctr  As Integer
    Dim oRS  As ADODB.Recordset
    Dim oCn  As ADODB.Connection
    Dim lOrigin As Long
    Dim lDest   As Long
    Dim sOrigin As String
    Dim sDest   As String
    On Error GoTo PRINT_EH
    Set oRS = New ADODB.Recordset
    Set oCn = New ADODB.Connection
    oCn.Open ConString
    oRS.Open "SELECT Origin, Destination, Amount FROM Fares", oCn, adOpenForwardOnly, adLockReadOnly
    ctr = 1
    Printer.Font = "Courier"
    Printer.FontSize = 10
    Printer.Print " "
    Printer.Print " "
    Printer.Print "     " & FormatDateTime(Date, vbLongDate)
    Printer.Print " "
    Printer.FontSize = 12
    Printer.Print "                                                             Fares Listing"
    Printer.Print " "
    Printer.Print " "
    Printer.FontSize = 10
    With oRS
            If .Fields("Destination") <> "No Show" Then
                sOrigin = Mid$(.Fields("Origin"), 1, 30)
                sDest = Mid$(.Fields("Destination"), 1, 30)
                lOrigin = Len(sOrigin)
                lDest = Len(sDest)
                Printer.Print sOrigin & Space(30 - lOrigin) & Chr(9) & sDest & Space(30 - lDest) & Chr(9) & Format(Format(.Fields("Amount"), "###,##0.00"), "@@@@@@@@@@@")
                If Printer.CurrentY > Printer.ScaleHeight - 1000 Then
                    Printer.Print " "
                    Printer.Print " "
                    Printer.Print "                                                             Page " & ctr
                    ctr = ctr + 1
                End If
            End If
        Loop Until .EOF
    End With
    Set oRS = Nothing
    Set oCn = Nothing
   Exit Sub
   MsgBox "Error Printing Report", vbCritical, "Printing Error"
End Sub

Thanks in advance!
Question by:alicelknight
  • 2
  • 2

Expert Comment

ID: 6852357
Hi, have you considered using a reporting tool?  One is available with VB6, DataReport.  Or u may use Crystal Reports from Seagate.

LVL 17

Accepted Solution

inthedark earned 400 total points
ID: 6852450
Here is a usage summary of how to handle the printer.  The part you need is how to use currentx & currenty and also the is a bit about Handling Columns.

It is not hard to use VB's printer object. Here are some more samples using the VB Printer object or
a picture box for print preview.

When you realy get some subroutines together it is quicker to create your report in VB than either Access
or Data  reports.

After each ============== is a handy code section showing an example.

You can print anywhere you like on your page within the following positions:

l = Printer.ScaleLeft ' you must print to the right of here
t = Printer.ScaleTop ' below here
h = Printer.ScaleHeight ' above here
w = Printer.ScaleWidth ' left of here

' output to picture box or printer
If preview Then
  Set outp = picMyPictureControl
  outp.Height = Printer.Height
  outp.Width = Printer.Width
  Set outp = Printer
End If

' Change font
outp.Font.Name = "Arial"
outp.Font.Size = 8

' set line height to height of fields + a littlebit more
lineheight = outp.TextHeight("X") * 1.01

' set a factor so that you can think in either inches or centimeters
twips = 1440 ' or 567 for centimeters

'set margins
leftmargin = twips * 0.5 ' Set .5 inches from left

' set topmargin
topmargin = twips * 2 ' Set 2 inches from top
if Not Preview then
  if topmargin < t then
    topmargin = t
  end if
end if
' set bottom point
bottompoint = outp.ScaleHeight - lineheight - twips * 1

' set mid pint
centerpoint = (outp.ScaleWidth - outp.ScaleLeft) * 0.5 + outp.ScaleLeft

' set rightmargin
rightmargin = outp.ScaleWidth - twips * 0.5

' Now do some printing
' move to printing position
outp.CurrentX = leftmargin
outp.CurrentY = topmargin

outp.Print "Print some text";

' print next field
outp.CurrentX = leftmargin + 2 * twips ' tab over 2 inches
outp.Print "Print some more";

' right justify to right side
outp.CurrentX = outp.ScaleWidth - outp.TextWidth(YourText$)
outp.Print YourText$;

' center justify
outp.CurrentX = centerpoint - outp.TextWidth(YourText$) * 0.5
outp.Print YourText$;

' tab to  2 inches from the left
Printer.CurrentX = 2 * twips

outp.Print "Print some more";

' Advance to next line
outp.CurrentY = outp.CurrentY + lineheight

' draw a line across
outp.line (leftmargin,outp.currenty)-(rightmargin-outp.currenty),0,bf

' draw a box arround an area
' you can also handle shading here as well rgb(250,250,250)but you
' need to use a windows API call to print on top of shading
' due to bug in windows
outp.line (leftmargin,topmargin)-(rightmargin-bottompoint),rgb(0,0,0),B

' Have we reached end of page or is this the top of the first page

Gosub CheckPage

If Page=0 or outp.CurrentY > bottompoint Then

  Page = Page + 1
  if page>1 Then ' if first page don't to end of page  
      ' print bottom of page stuff here
      outp.CurrentY = bottompoint - twips * 0.5
      outp.CurrentX = centerpoint
      outp.Print "Page " + CStr(Page);
      If preview Then
          ok = MsgBox("Continue Y/N", vbYesNo + _ vbQuestion, "End of Page")
          If ok <> vbYes Then
               ' unload your preview form
               Exit Sub
          end if
          outp.CurrentY = topmargin
      End If
  End If
  ' handle page headings in a gosub or soubroutine here
  gosub PrintHeadings
End If

Handling Columns

When working with columns ther are 2 ways simple way using a fixed width font or hard way using proporional width font.

Fixed width font - all characters are the same width so you control columns by using spaces:

printer.font.name = "Courier New" ' courier new is a fixed width font"
printer.font.size = 8

printer.print "AAA BBB WWW XXX"; ' no line yet
printer.print " YYY ZZZ" ' no ; so makes a new line

printer.print "123 456 789 000 444 555"

Proportional fonts:

Set up column positions (read below info below for better descriptions of each part).

twips = 1440 ' is twips per inch or use 567 for metric

smallgap = twips * .01 ' width of column gaps

' set up position of first column
colpos(1) = printer.scaleleft ' this is leftt most margin

' load the data to print as strings

coldata(1)="Some Text"

' now setup widths of columns
colwidth(1) = 1.5 * twips
colwidth(2) = 1.5 * twips
colwidth(3) = 1.5 * twips
colwidth(4) = 1.5 * twips

' Now justification of each column

colJustify(1)="L" ' left
colJustify(2)="R" ' right
colJustify(3)="C" ' center

' make sue you have a right margine too
redim preserve colpos(columnscount+1)

' Now Calculate column positions
for c= 2 to columnscount
   colpos(c) + colpos(c-1) + smallgap + colwidth(c-1) + smallgap
next c

defaultfontsize = 12

' now calculate the places to print for each colunn

' print horrizontal grid lines here if required

for c= 1 to columnscount
   ' make sure data will fit in gap
   ' reduce font size to fit in space

   outp.font.size = defaultfontsize
       if outp.textwidth(coldata(c)) <= colwidth(c) then exit do
       ' reduce font size until text fits
       outp.font.size = outp.font.size * .95
        if outp.font.size < 5 then exit do   ' stop loop potential
   select case ucase(coljustify(c))
     case = "R" ' right
          colplace(c) = colpos(c+1)-smallgap - Outp.TextWidth(coldata(c))  
      case = "C" ' center justify
          colplace(c) = colpos(c)+ smallgap + colwidth(c) * .5 - Outp.TextWidth(coldata(c)) * .5  
      case else ' left jusify
        colplace(c) = colpos(c+1) + smallgap

   end select
   outp.currentx =  colplace(c)
   outp.print coldata(c);
Next c

' move move done to next line
outp.currenty = outp.currenty + lineheight

'or you can draw lines accross

'draw vertical lines

' save the position before you start printing columns
storetopofbox = outp.currenty

gosub printcolumns

' now print vertical lines
baseofbox = outp.currenty

for c=1 to columns + 1
   outp.line (colpos(c),storetopofbox) - (colpos(c),baseofbox),0,bf
next c  

' Graphics
' picG is the image you wish to print
' Both picG.Image and picG.Pictue can be used as a source

' S=Source of picture

' so you can crop the source picure like
sx =  cropleft ' Source x position
sy =  croptop
sw =  picG.ScaleWidth - cropright
sh = picG.ScaleHeight - cropbottom

' D=Destination pos X,Y and H & W is height and width
' e.g. DX=destination x postion

DX = t
DY = l
DW = r-l

' keep same aspect ratio of pircure width/height relationship

ARatio=picG.scaleheight/picg.scalewidth ' aspect ratio of source picture

' because  dh / dw = sh / sw = ARatio
' you can find the correct dh from dw
DH = DW * ARatio

' the raster op allows pictures to be merged, or just plain copied type "RasterOpConstants." to see
list of options

RasterOp = RasterOpConstants.vbSrcCopy

' now print the graphic
outp.PaintPicture picG.Picture, DX, DY, DW, DH, SX, SY, SW, SH, RasterOp

' you can create effects like upside down and mirror using -DH and -DW

' Autoshrink

Before you print your graphic you can test to see if it fits on the page, if it is too large then shrink
it a little so it fits.

Imagine you want to print at height position hp and left poisition lp you graphic is in picture box

' set position where graphic is to be printerd.
DX = lp ' set desintation x
DY = hp ' set desintation y
DW = picG.Width
DH = picG.Height

' now here is the cute bit to stop graphic going over page.

If DH + DY > h Then ' where h = printer.scaleheight
  DH = h - DY ' set the height to the remaining height
  DW = DW * (DH / picG.Height) ' reduce width by same propotion
End If

Printer.PaintPicture picG.Picture, DX, DY, DW, DH

' Finishing up

Page = Page + 1

' print bottom of page stuff here
' best done in another subroutine
outp.CurrentY = bottompoint - twips * 0.5
outp.CurrentX = centerpoint
outp.Print "Page " + CStr(Page)

If preview Then
  ok = MsgBox("Complete", vbExclamation, "End of Document")
End If

' to abandon printing
If Not preview Then
End If

' Shading and transparent fonts

' First print a box
outp.Line (LeftM, startplace)-(RightM, endplace), RGB(247, 247, 247), BF
outp.FillStyle = 1 ' this should work in NT but not in 95
outp.FontTransparent = True
If Not preview Then ' fix windows 95 bug
  iBKMode = SetBkMode(outp.hdc, TRANSPARENT)
end if

' You need this in a code module
Public Declare Function SetBkMode Lib "gdi32" _
    (ByVal hdc As Long, ByVal nBkMode As Long) As Long

Public iBKMode As Long
Public Const TRANSPARENT = 1
Public Const OPAQUE = 2


Author Comment

ID: 6853005
3Mann:  I do not want to use a reporting tool.  I find Data Reports too time consuming for the benefit they provide.  Also the inability to dynamically set the connection string is another downfall.  But that is another topic.....

InTheDark:  Thanks! This is just what I needed.  
LVL 17

Expert Comment

ID: 6853506
Hi alicelknight, thanks for the points. In 1996, before classes, I created a Module to handle printing.

For me to create a report now I just type:

SQL = "Select * from MtyTable;"
ok = prPrintReport("REPNAME",SQL,"Help Topic","Help Sub Topic")

I then just answer questions to comple the rest of the process.  It takes just seconds.

How long does it take to reate a report using Data Reports?

Author Comment

ID: 6853582
InTheDark:  Shi...  Trying to use DataReports to create one simple report may take hours.  Aligning controls and such...  I've come to detest it. Thanks to your code I can come with a simple solution as you have.  It's better too because I don't have to depend on a "connection string...." I've yet to figure that one out.  I've tried many different ways, examples, that I've seen but none worked. So I stay far from DataReports!  And Data Environments!  Right now I have to redo code that was done using a Data Environment at work.  The reports are next.... ;)  I can't tell you how your code has helped me! :)

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
This article describes some techniques which will make your VBA or Visual Basic Classic code easier to understand and maintain, whether by you, your replacement, or another Experts-Exchange expert.
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…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

619 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