VB Printing Problem

D

Dillirium

Limp Gawd
Joined
Sep 16, 2004
Messages
439
Hello everyone. I'm in the process of making a dynamic phone list and I did it in a funky way ^-^ But I'd like some help. When I print out my form in vb after it's populated from a database everything is fine if the resolution is high enough. however If i turn the resolution in windows down to 800x600 from 1280x1024.. then stuff that should of printed gets cut off. So i end up w/ like 3/4 of a page instead of the full page of phone #'s.

The code is pretty straight forward .. for printing I simply use printform ... works fine at my resolution like I said but not others.. any ideas? Here's the code just in case
_________________________________________________________________________
Option Explicit

Private Sub cmdPrint_Click()
Clipboard.SetData Phone_List.Form1, vbCFDIB
cmdPrint.Visible = False
DoEvents
PrintForm
DoEvents
cmdPrint.Visible = True
End Sub

Private Sub Form_Load()

Dim strExt As String
Dim strName As String
Dim strCell As String
Dim strTitle As String
Dim strRow As String
Dim strHARSQL As String
Dim strFEXSQL As String
Dim strWHSQL As String
Dim strMEMPHSQL As String
Dim strNESQL As String
Dim strFaxSQL As String
Dim strImpSQL As String

Dim cn As ADODB.Connection
Dim rsFex As ADODB.Recordset
Dim rsHar As ADODB.Recordset
Dim rsWH As ADODB.Recordset
Dim rsMemph As ADODB.Recordset
Dim rsNE As ADODB.Recordset
Dim rsImp As ADODB.Recordset
Dim rsFax As ADODB.Recordset

'intialize variables
strFEXSQL = "SELECT First_Name, Last_Name, Extension, Cell, Title, Phone From Employee Where Location='Atlas' Order By First_Name, Last_Name"
strHARSQL = "SELECT First_Name, Last_Name, Extension, Cell, Title, Phone From Employee Where Location='Harrison' Order By First_Name, Last_Name"
strWHSQL = "SELECT First_Name, Last_Name, Extension, Cell, Title, Phone From Employee Where Location='Renner' Order By First_Name, Last_Name"
strMEMPHSQL = "SELECT First_Name, Last_Name, Extension, Cell, Title, Phone From Employee Where Location='Memphis' Order By First_Name, Last_Name"
strNESQL = "SELECT First_Name, Last_Name, Extension, Cell, Title, Phone From Employee Where Location='NEOHIO' Order By First_Name, Last_Name"
strFaxSQL = "SELECT receiver, number, purpose from other Where Purpose='Fax' Order By receiver"
strImpSQL = "SELECT receiver, number, purpose from other Where Purpose='Important' Order By receiver"
strExt = ""
strName = ""
strCell = ""
strTitle = ""
strRow = ""
picATLAS.Cls
picHarrison.Cls
picATLAS.CurrentX = 0
picATLAS.CurrentY = 0
picHarrison.CurrentX = 0
picHarrison.CurrentY = 0
'picATLAS.FontSize = 6


Set cn = New ADODB.Connection
Set rsFex = New ADODB.Recordset
Set rsHar = New ADODB.Recordset
Set rsWH = New ADODB.Recordset
Set rsMemph = New ADODB.Recordset
Set rsNE = New ADODB.Recordset
Set rsFax = New ADODB.Recordset
Set rsImp = New ADODB.Recordset

cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=\\Fstdata\data\InfoSystems\IS.MDB;Mode=ReadWrite;Persist Security Info=False"
cn.Open

'''''''''''''''''''''''''''''''''''''''''''''ATLAS''''''''''''''''''''''''''
rsFex.Open strFEXSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
rsFex.MoveFirst
Do Until rsFex.EOF

If Not IsNull(rsFex.Fields("Extension")) Then
strExt = rsFex.Fields("Extension")
End If
If Not IsNull(rsFex.Fields("First_Name")) And Not IsNull(rsFex.Fields("Last_Name")) Then
strName = rsFex.Fields("First_Name") + " " + rsFex.Fields("Last_Name")
End If
If Not IsNull(rsFex.Fields("Cell")) Then
strCell = rsFex.Fields("Cell")
End If
If Not IsNull(rsFex.Fields("Title")) Then
strTitle = rsFex.Fields("Title")
End If
'add the fexrecords
If strExt <> "" And strName <> "" And rsFex.Fields("Phone") = "1" Then
picATLAS.Print strExt; Tab(8); strName; Tab(27); strCell; Tab(41); strTitle
End If


strExt = ""
strName = ""
strCell = ""
strTitle = ""
strRow = ""
rsFex.MoveNext
Loop
picATLAS.Picture = picATLAS.Image
'''''''''''''''''''''''''''''''HARRISON''''''''''''''''''''''''''''''''''

rsHar.Open strHARSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
rsHar.MoveFirst
Do Until rsHar.EOF

If Not IsNull(rsHar.Fields("Extension")) Then
strExt = rsHar.Fields("Extension")
End If
If Not IsNull(rsHar.Fields("First_Name")) And Not IsNull(rsHar.Fields("Last_Name")) Then
strName = rsHar.Fields("First_Name") + " " + rsHar.Fields("Last_Name")
End If
If Not IsNull(rsHar.Fields("Cell")) Then
strCell = rsHar.Fields("Cell")
End If
If Not IsNull(rsHar.Fields("Title")) Then
strTitle = rsHar.Fields("Title")
End If
'add the fexrecords
If strExt <> "" And strName <> "" And rsHar.Fields("Phone") = "1" Then
picHarrison.Print strExt; Tab(8); strName; Tab(27); strCell; Tab(41); strTitle
End If
strExt = ""
strName = ""
strCell = ""
strTitle = ""
strRow = ""
rsHar.MoveNext
Loop
picHarrison.Picture = picHarrison.Image
'''''''''''''''''''''''''''''''''Renner'''''''''''''''''''''''''''''''''''

rsWH.Open strWHSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
rsWH.MoveFirst
Do Until rsWH.EOF

If Not IsNull(rsWH.Fields("Extension")) Then
strExt = rsWH.Fields("Extension")
End If
If Not IsNull(rsWH.Fields("First_Name")) And Not IsNull(rsWH.Fields("Last_Name")) Then
strName = rsWH.Fields("First_Name") + " " + rsWH.Fields("Last_Name")
End If
If Not IsNull(rsWH.Fields("Cell")) Then
strCell = rsWH.Fields("Cell")
End If
If Not IsNull(rsWH.Fields("Title")) Then
strTitle = rsWH.Fields("Title")
End If
'add the fexrecords
If strExt <> "" And strName <> "" And rsWH.Fields("Phone") = "1" Then
picWH.Print strExt; Tab(8); strName; Tab(27); strCell; Tab(41); strTitle
End If
strExt = ""
strName = ""
strCell = ""
strTitle = ""
strRow = ""
rsWH.MoveNext
Loop
picWH.Picture = picWH.Image

'''''''''''''''''''''''''''''Memphis'''''''''''''''''''''''''''''''''''''''

rsMemph.Open strMEMPHSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
rsMemph.MoveFirst
Do Until rsMemph.EOF

If Not IsNull(rsMemph.Fields("Extension")) Then
strExt = "" 'rsMemph.Fields("Extension")
End If
If Not IsNull(rsMemph.Fields("First_Name")) And Not IsNull(rsMemph.Fields("Last_Name")) Then
strName = rsMemph.Fields("First_Name") + " " + rsMemph.Fields("Last_Name")
End If
If Not IsNull(rsMemph.Fields("Cell")) Then
strCell = rsMemph.Fields("Cell")
End If
If Not IsNull(rsMemph.Fields("Title")) Then
strTitle = rsMemph.Fields("Title")
End If
'add the fexrecords
If strName <> "" And rsMemph.Fields("Phone") = "1" Then
picMemphis.Print strExt; Tab(8); strName; Tab(27); strCell; Tab(41); strTitle
End If
strExt = ""
strName = ""
strCell = ""
strTitle = ""
strRow = ""
rsMemph.MoveNext
Loop
picMemphis.Picture = picMemphis.Image

'''''''''''''''''''''''''''''NE Ohio''''''''''''''''''''''''''''''''''''''''

rsNE.Open strNESQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
rsNE.MoveFirst
Do Until rsNE.EOF

If Not IsNull(rsNE.Fields("Extension")) Then
strExt = "" 'rsNE.Fields("Extension")
End If
If Not IsNull(rsNE.Fields("First_Name")) And Not IsNull(rsNE.Fields("Last_Name")) Then
strName = rsNE.Fields("First_Name") + " " + rsNE.Fields("Last_Name")
End If
If Not IsNull(rsNE.Fields("Cell")) Then
strCell = rsNE.Fields("Cell")
End If
If Not IsNull(rsNE.Fields("Title")) Then
strTitle = rsNE.Fields("Title")
End If
'add the fexrecords
If strName <> "" And rsNE.Fields("Phone") = "1" Then
picNEOHIO.Print strExt; Tab(8); strName; Tab(27); strCell; Tab(41); strTitle
End If
strExt = ""
strName = ""
strCell = ""
strTitle = ""
strRow = ""
rsNE.MoveNext
Loop
picNEOHIO.Picture = picNEOHIO.Image

''''''''''''''''''''''''''''Faxes''''''''''''''''''''''''''''''''''''''''''''
rsFax.Open strFaxSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
rsFax.MoveFirst
Do Until rsFax.EOF

If Not IsNull(rsFax.Fields("receiver")) Then
strName = rsFax.Fields("receiver")
End If
strCell = rsFax.Fields("number")
'add the Fax records

picFax.Print strName; Tab(30); strCell

strName = ""
strCell = ""

rsFax.MoveNext
Loop
picFax.Picture = picFax.Image

''''''''''''''''''''''''''''Important Numbers'''''''''''''''''''''''''''''''
rsImp.Open strImpSQL, cn, adOpenForwardOnly, adLockReadOnly, adCmdText
rsImp.MoveFirst
Do Until rsImp.EOF

If Not IsNull(rsImp.Fields("receiver")) Then
strName = rsImp.Fields("receiver")
End If
strCell = rsImp.Fields("number")
'add the Fax records

picImp.Print strName; Tab(30); strCell

strName = ""
strCell = ""

rsImp.MoveNext
Loop
picImp.Picture = picImp.Image

rsFax.Close
rsImp.Close
rsMemph.Close
rsNE.Close
rsWH.Close
rsHar.Close
rsFex.Close
cn.Close
End Sub
 
You must log in or register to reply here.
Back
Top