Solved

Printing Problem

Posted on 2002-03-08
5
315 Views
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
        Do
            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
                    Printer.NewPage
                End If
            End If
            .MoveNext
        Loop Until .EOF
    End With
    Printer.EndDoc
   
    oRS.Close
    oCn.Close
    Set oRS = Nothing
    Set oCn = Nothing
   
   Exit Sub
PRINT_EH:
   MsgBox "Error Printing Report", vbCritical, "Printing Error"
   Err.Clear
End Sub


Thanks in advance!
Alice
0
Comment
Question by:alicelknight
  • 2
  • 2
5 Comments
 
LVL 1

Expert Comment

by:3Mann
Comment Utility
Hi, have you considered using a reporting tool?  One is available with VB6, DataReport.  Or u may use Crystal Reports from Seagate.

Cheers
0
 
LVL 17

Accepted Solution

by:
inthedark earned 100 total points
Comment Utility
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
  outp.Cls
Else
  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

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.Cls
          outp.CurrentY = topmargin
      Else
          outp.NewPage
          outp.currentx=leftmargin
          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"
coldata(2)format(Date,dd-mm-yy")
etc.


' 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
etc.

' 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
   do
       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
   loop
   
   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
picG.

' 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")
Else
  outp.EndDoc
End If


'=================
' to abandon printing
If Not preview Then
  outp.KillDoc
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


0
 

Author Comment

by:alicelknight
Comment Utility
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.  
0
 
LVL 17

Expert Comment

by:inthedark
Comment Utility
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?
0
 

Author Comment

by:alicelknight
Comment Utility
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! :)
Alice
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
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…
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…

772 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

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now