P
poolguard
Situation:
The lawfirm that i work for uses a "Print toolbar" that pulls all try
settings from a database.
Class Name PrinterObject
Option Explicit
Private priLetter As Integer
Private priBond As Integer
Private priDraft As Integer
Private priEnv As Integer
Private priManual As Integer
Private priLabel As Integer
' **Public Properties**
'Returns the letter head tray number
Public Property Get Letterhead()
Letterhead = priLetter
End Property
'Returns the bond paper tray number
Public Property Get Bond()
Bond = priBond
End Property
'returns the Draft tray number
Public Property Get Draft()
Draft = priDraft
End Property
'Returns the env tray number
Public Property Get Env()
Env = priEnv
End Property
'Returns the manual tray number
Public Property Get Manual()
Manual = priManual
End Property
'returns the label tray number
Public Property Get Label()
Label = priLabel
End Property
Public Function GetPrinter(Name As String) As Boolean
'Determins if we need to set up the registry
Dim Reg As Boolean
Reg = Registry
If Reg = True Then
'If reg is true and the registry is setup then we need to test for an over
ride condishion
If ShouldOverRide Then
'if we should overide the database and use the registry
If GetPrinterFromReg = True Then
GetPrinter = True
Else
GetPrinter = False
End If
Else
'if we should use the database
If GetPrinterFromDB(Name) = True Then
Dim Holder As Boolean
Holder = SetPrinterInReg
GetPrinter = True
Else
'if it can not get the printer from the database then it will
try the Registry
If GetPrinterFromReg = True Then
GetPrinter = True
Else
GetPrinter = False
End If
End If
End If
Else
'if the registry is not setup we will use the database settings and
'set up the registry
If GetPrinterFromDB(Name) = True Then
Holder = SetPrinterInReg
Holder = WriteReg("ShouldOverRide", "False")
GetPrinter = True
Else
GetPrinter = False
End If
End If
End Function
Private Function ShouldOverRide() As Boolean
'Determins if the database should be read or if the values in the registry
should be used
If ReadReg("ShouldOverRide") = "True" Then
ShouldOverRide = True
Else
ShouldOverRide = False
End If
End Function
Private Function Registry() As Boolean
'Determins if there are any setting in the registry to use
If ReadReg("ShouldOverRide") = "" Then
Registry = False
Else
Registry = True
End If
End Function
'************************************************
'* These functions get the commands from *
'* the registry or the database *
'************************************************
Private Function GetPrinterFromReg() As Boolean
'reads the printer object from the registry
GetPrinterFromReg = False
On Error Resume Next
priLetter = ReadReg("LetterHead")
priBond = ReadReg("Bond")
priDraft = ReadReg("Draft")
priEnv = ReadReg("env")
priManual = ReadReg("Manual")
priLabel = ReadReg("Label")
On Error GoTo 0
GetPrinterFromReg = True
End Function
Private Function SetPrinterInReg() As Boolean
'writes the printer object to the registry
If WriteReg("LetterHead", priLetter) = False Or WriteReg("Bond", priBond) =
False Or WriteReg("Draft", priDraft) = False Or WriteReg("Env", priEnv) =
False Or WriteReg("Manual", priManual) = False Or WriteReg("Label", priLabel)
= False Then
SetPrinterInReg = False
Else
SetPrinterInReg = True
End If
End Function
Private Function GetPrinterFromDB(Name As String) As Boolean
'reads the printer object from the database
GetPrinterFromDB = False
'this code accesses the database and filles in the values for the private var.
Dim db_name As String
Dim conn As ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SqlStr As String
' Connect to the database.
Set conn = New ADODB.Connection
conn.Mode = adModeRead
conn.ConnectionString = "Provider=SQLOLEDB;Data Source=Lancbw1; User ID=SA;
Password=1to1; initial catalog=BarleySnyder"
On Error Resume Next
conn.Open
'Set Sel Query
SqlStr = "SELECT Top 1 * FROM Tbl_Word_Printer where PrinterName = '" & Name
& "'"
rs.Open SqlStr, conn
rs.MoveFirst
priLetter = rs("LtrHead")
priBond = rs("Bond")
priDraft = rs("Draft")
priEnv = rs("Env")
priManual = rs("Manual")
priLabel = rs("Manual")
rs.Close
conn.Close
On Error GoTo 0
GetPrinterFromDB = True
End Function
'****************************************************
'* Reads The individual settingd in the registry *
'* Does not fill the private setting on this *
'* object *
'****************************************************
Private Function WriteReg(Key As String, KeyValue) As Boolean
'writes to the registry
Dim Section As String
Section = "HKEY_CURRENT_USER\Software\BarleySnyder\Word"
'Dim wd As Word.Application
WriteReg = False
'Set wd = New Word.Application ' create the Word application object
On Error Resume Next
System.PrivateProfileString("", Section, Key) = CStr(KeyValue)
On Error GoTo 0
'wd.Quit
'Set wd = Nothing ' destroy the Word application object
WriteReg = True
End Function
Private Function ReadReg(Key As String) As String
'reads from the registry
Dim Section As String
Section = "HKEY_CURRENT_USER\Software\BarleySnyder\Word"
'the Commented out lines below are used if this is not in a word macro
'it slows things down greatly
'Dim wd As Word.Application
ReadReg = ""
'Set wd = New Word.Application ' create the Word application object
On Error Resume Next
ReadReg = System.PrivateProfileString("", Section, Key)
On Error GoTo 0
'wd.Quit
'Set wd = Nothing ' destroy the Word application object
End Function
Then prints the document in a certin way depending on the macro toolbar
button that was pressed. See Below
Public Function MacroPrint(ByVal firstPageTray As Integer, ByVal
secondPageTray As Integer, numbersPage As Integer, activityPage As String,
PrintType As String) As Boolean
On Error Resume Next
' Write Word print macro here:
' For example: ActiveDocument.PrintOut , , wdPrintCurrentPage
'Set Tray Numbera
With ActiveDocument.PageSetup
.firstPageTray = firstPageTray
.OtherPagesTray = secondPageTray
End With
'Select the Correct Case and Print the document
If PrintType = "All" Then
ActiveDocument.PrintOut Collate:=True
ElseIf PrintType = "One" Then
ActiveDocument.PrintOut Range:=wdPrintCurrentPage
ElseIf PrintType = "Block" Then
Application.PrintOut FileName:="", Range:=wdPrintSelection, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="",
PageType:=wdPrintAllPages, _
Collate:=True, Background:=True, PrintToFile:=False
ElseIf PrintType = "Env" Then
Application.PrintOut FileName:="", Range:=wdPrintCurrentPage, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="1",
PageType:=wdPrintCurrentPage, _
Collate:=True, Background:=True, PrintToFile:=False
End If
'Reset Trays to default
With ActiveDocument.PageSetup
.firstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
End With
MacroPrint = True
End Function
The Problem:
When someone inserts a Next Page Break the second page prints with the same
settings as the first page.
Example:
Printing a letter
First page should print on the letterhead paper and the second and all other
pages should print on plain paper.
What happens is if there is a next page break on the first page both the
first and second pages print out on letterhead and all other print out on
plain paper.
Thanks
Let me know if you need anymore info
Chris
The lawfirm that i work for uses a "Print toolbar" that pulls all try
settings from a database.
Class Name PrinterObject
Option Explicit
Private priLetter As Integer
Private priBond As Integer
Private priDraft As Integer
Private priEnv As Integer
Private priManual As Integer
Private priLabel As Integer
' **Public Properties**
'Returns the letter head tray number
Public Property Get Letterhead()
Letterhead = priLetter
End Property
'Returns the bond paper tray number
Public Property Get Bond()
Bond = priBond
End Property
'returns the Draft tray number
Public Property Get Draft()
Draft = priDraft
End Property
'Returns the env tray number
Public Property Get Env()
Env = priEnv
End Property
'Returns the manual tray number
Public Property Get Manual()
Manual = priManual
End Property
'returns the label tray number
Public Property Get Label()
Label = priLabel
End Property
Public Function GetPrinter(Name As String) As Boolean
'Determins if we need to set up the registry
Dim Reg As Boolean
Reg = Registry
If Reg = True Then
'If reg is true and the registry is setup then we need to test for an over
ride condishion
If ShouldOverRide Then
'if we should overide the database and use the registry
If GetPrinterFromReg = True Then
GetPrinter = True
Else
GetPrinter = False
End If
Else
'if we should use the database
If GetPrinterFromDB(Name) = True Then
Dim Holder As Boolean
Holder = SetPrinterInReg
GetPrinter = True
Else
'if it can not get the printer from the database then it will
try the Registry
If GetPrinterFromReg = True Then
GetPrinter = True
Else
GetPrinter = False
End If
End If
End If
Else
'if the registry is not setup we will use the database settings and
'set up the registry
If GetPrinterFromDB(Name) = True Then
Holder = SetPrinterInReg
Holder = WriteReg("ShouldOverRide", "False")
GetPrinter = True
Else
GetPrinter = False
End If
End If
End Function
Private Function ShouldOverRide() As Boolean
'Determins if the database should be read or if the values in the registry
should be used
If ReadReg("ShouldOverRide") = "True" Then
ShouldOverRide = True
Else
ShouldOverRide = False
End If
End Function
Private Function Registry() As Boolean
'Determins if there are any setting in the registry to use
If ReadReg("ShouldOverRide") = "" Then
Registry = False
Else
Registry = True
End If
End Function
'************************************************
'* These functions get the commands from *
'* the registry or the database *
'************************************************
Private Function GetPrinterFromReg() As Boolean
'reads the printer object from the registry
GetPrinterFromReg = False
On Error Resume Next
priLetter = ReadReg("LetterHead")
priBond = ReadReg("Bond")
priDraft = ReadReg("Draft")
priEnv = ReadReg("env")
priManual = ReadReg("Manual")
priLabel = ReadReg("Label")
On Error GoTo 0
GetPrinterFromReg = True
End Function
Private Function SetPrinterInReg() As Boolean
'writes the printer object to the registry
If WriteReg("LetterHead", priLetter) = False Or WriteReg("Bond", priBond) =
False Or WriteReg("Draft", priDraft) = False Or WriteReg("Env", priEnv) =
False Or WriteReg("Manual", priManual) = False Or WriteReg("Label", priLabel)
= False Then
SetPrinterInReg = False
Else
SetPrinterInReg = True
End If
End Function
Private Function GetPrinterFromDB(Name As String) As Boolean
'reads the printer object from the database
GetPrinterFromDB = False
'this code accesses the database and filles in the values for the private var.
Dim db_name As String
Dim conn As ADODB.Connection
Dim rs As New ADODB.Recordset
Dim SqlStr As String
' Connect to the database.
Set conn = New ADODB.Connection
conn.Mode = adModeRead
conn.ConnectionString = "Provider=SQLOLEDB;Data Source=Lancbw1; User ID=SA;
Password=1to1; initial catalog=BarleySnyder"
On Error Resume Next
conn.Open
'Set Sel Query
SqlStr = "SELECT Top 1 * FROM Tbl_Word_Printer where PrinterName = '" & Name
& "'"
rs.Open SqlStr, conn
rs.MoveFirst
priLetter = rs("LtrHead")
priBond = rs("Bond")
priDraft = rs("Draft")
priEnv = rs("Env")
priManual = rs("Manual")
priLabel = rs("Manual")
rs.Close
conn.Close
On Error GoTo 0
GetPrinterFromDB = True
End Function
'****************************************************
'* Reads The individual settingd in the registry *
'* Does not fill the private setting on this *
'* object *
'****************************************************
Private Function WriteReg(Key As String, KeyValue) As Boolean
'writes to the registry
Dim Section As String
Section = "HKEY_CURRENT_USER\Software\BarleySnyder\Word"
'Dim wd As Word.Application
WriteReg = False
'Set wd = New Word.Application ' create the Word application object
On Error Resume Next
System.PrivateProfileString("", Section, Key) = CStr(KeyValue)
On Error GoTo 0
'wd.Quit
'Set wd = Nothing ' destroy the Word application object
WriteReg = True
End Function
Private Function ReadReg(Key As String) As String
'reads from the registry
Dim Section As String
Section = "HKEY_CURRENT_USER\Software\BarleySnyder\Word"
'the Commented out lines below are used if this is not in a word macro
'it slows things down greatly
'Dim wd As Word.Application
ReadReg = ""
'Set wd = New Word.Application ' create the Word application object
On Error Resume Next
ReadReg = System.PrivateProfileString("", Section, Key)
On Error GoTo 0
'wd.Quit
'Set wd = Nothing ' destroy the Word application object
End Function
Then prints the document in a certin way depending on the macro toolbar
button that was pressed. See Below
Public Function MacroPrint(ByVal firstPageTray As Integer, ByVal
secondPageTray As Integer, numbersPage As Integer, activityPage As String,
PrintType As String) As Boolean
On Error Resume Next
' Write Word print macro here:
' For example: ActiveDocument.PrintOut , , wdPrintCurrentPage
'Set Tray Numbera
With ActiveDocument.PageSetup
.firstPageTray = firstPageTray
.OtherPagesTray = secondPageTray
End With
'Select the Correct Case and Print the document
If PrintType = "All" Then
ActiveDocument.PrintOut Collate:=True
ElseIf PrintType = "One" Then
ActiveDocument.PrintOut Range:=wdPrintCurrentPage
ElseIf PrintType = "Block" Then
Application.PrintOut FileName:="", Range:=wdPrintSelection, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="",
PageType:=wdPrintAllPages, _
Collate:=True, Background:=True, PrintToFile:=False
ElseIf PrintType = "Env" Then
Application.PrintOut FileName:="", Range:=wdPrintCurrentPage, Item:= _
wdPrintDocumentContent, Copies:=1, Pages:="1",
PageType:=wdPrintCurrentPage, _
Collate:=True, Background:=True, PrintToFile:=False
End If
'Reset Trays to default
With ActiveDocument.PageSetup
.firstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
End With
MacroPrint = True
End Function
The Problem:
When someone inserts a Next Page Break the second page prints with the same
settings as the first page.
Example:
Printing a letter
First page should print on the letterhead paper and the second and all other
pages should print on plain paper.
What happens is if there is a next page break on the first page both the
first and second pages print out on letterhead and all other print out on
plain paper.
Thanks
Let me know if you need anymore info
Chris
