Steve Conklin (Developer@UltraDNT)
Developer at UltraDNT.com
Wed Feb 9 08:26:12 CST 2005
Hey, Gustav.
I found the code I used, from msdn, but it doesn't use registry
directly, it gets the paper numbers through an API call. The sub is
"GetPaperList", but this code uses the Printer object, which is only
good on AXP+. You'll have to work around that.
hth
Steve
>>>> begin msdn code:
Option Compare Database
Option Explicit
' Declaration for the DeviceCapabilities function API call.
Private Declare Function DeviceCapabilities Lib "winspool.drv" _
Alias "DeviceCapabilitiesA" (ByVal lpsDeviceName As String, _
ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _
ByVal lpDevMode As Long) As Long
' DeviceCapabilities function constants.
Private Const DC_PAPERNAMES = 16
Private Const DC_PAPERS = 2
Private Const DC_BINNAMES = 12
Private Const DC_BINS = 6
Private Const DEFAULT_VALUES = 0
Sub ShowPrinters()
Dim strCount As String
Dim strMsg As String
Dim prtLoop As Printer
On Error GoTo ShowPrinters_Err
If Printers.Count > 0 Then
' Get count of installed printers.
strMsg = "Printers installed: " & Printers.Count & vbCrLf &
vbCrLf
' Enumerate printer system properties.
For Each prtLoop In Application.Printers
With prtLoop
strMsg = strMsg _
& "Device name: " & .DeviceName & vbCrLf _
& "Driver name: " & .DriverName & vbCrLf _
& "Port: " & .Port & vbCrLf & vbCrLf
End With
Next prtLoop
Else
strMsg = "No printers are installed."
End If
' Display printer information
MsgBox Prompt:=strMsg, Buttons:=vbOKOnly, Title:="Installed
Printers"
ShowPrinters_End:
Exit Sub
ShowPrinters_Err:
MsgBox Prompt:=Err.Description, Buttons:=vbCritical & vbOKOnly, _
Title:="Error Number " & Err.Number & " Occurred"
Resume ShowPrinters_End
End Sub
Sub ChangeBins()
Dim strReportName As String
Dim prt As Printer
On Error GoTo ChangeBins_Err
strReportName = "Alphabetical List Of Products"
'Open the report in print preview
DoCmd.OpenReport ReportName:=strReportName, View:=acViewPreview
' Get the Printer object for the report.
Set prt = Reports(strReportName).Printer
' Change the PaperBin property to print from the lower bin.
prt.PaperBin = acPRBNLower
' Use the PrintOut method to print only the first page of the
report.
DoCmd.PrintOut PrintRange:=acPages, PageFrom:=1, PageTo:=1
' Change the PaperBin property to print from the upper bin.
prt.PaperBin = acPRBNUpper
' Use the PrintOut method to print the remainder of the report by
' specifying 2 for the PageFrom argument and 32767 for the PageTo
' argument. Because 32767 is the maximum number of pages that can be
' printed, all remaining pages will be printed.
DoCmd.PrintOut PrintRange:=acPages, PageFrom:=2, PageTo:=32767
' Close report without saving changes.
DoCmd.Close ObjectType:=acReport, ObjectName:=strReportName,
Save:=acSaveNo
ChangeBins_End:
Exit Sub
ChangeBins_Err:
MsgBox Prompt:=Err.Description, Buttons:=vbCritical & vbOKOnly, _
Title:="Error Number " & Err.Number & " Occurred"
Resume ChangeBins_End
End Sub
Function GetPaperSize(frmName As Form) As AcPrintPaperSize
' Check the string in the cboPaperSize box, and
' pass back the corresponding AcPrintPaperSize
' constant.
Select Case frmName!cboPaperSize
Case "Letter"
GetPaperSize = acPRPSLetter
Case "Legal"
GetPaperSize = acPRPSLegal
Case "Statement"
GetPaperSize = acPRPSStatement
Case "Executive"
GetPaperSize = acPRPSExecutive
End Select
End Function
Function GetPaperBin(frmName As Form) As AcPrintPaperBin
' Check the string in the cboPaperBin box, and
' pass back the corresponding AcPrintPaperBin
' constant.
Select Case frmName!cboPaperBin
Case "Default"
GetPaperBin = acPRBNAuto
Case "Upper"
GetPaperBin = acPRBNUpper
Case "Middle"
GetPaperBin = acPRBNMiddle
Case "Lower"
GetPaperBin = acPRBNLower
End Select
End Function
Sub PrintReport(frmName As Form)
Dim prtApp As Printer
On Error GoTo PrintReport_Err
' Get selected printer and set user-specified settings
Set prtApp = Application.Printers(frmName!cboPrinter.Value)
With prtApp
.PaperSize = modPrinters.GetPaperSize(frmName)
.PaperBin = modPrinters.GetPaperBin(frmName)
.Copies = frmName!txtCopies
.Orientation = frmName!fraOrientation
End With
' Set report's printer to selected printer.
Reports(frmName!lstSelectReport).Printer = prtApp
' Check the value of the fraPrintRange option group
' frame to determine which option is selected. The
' OptionValue of the optAll option button is 1.
If frmName!fraPrintRange = 1 Then
DoCmd.PrintOut PrintRange:=acPrintAll
Else
DoCmd.PrintOut PrintRange:=acPages, PageFrom:=frmName!txtFrom, _
PageTo:=frmName!txtTo
End If
PrintReport_End:
Exit Sub
PrintReport_Err:
MsgBox Err.Description, vbCritical & vbOKOnly, _
"Error Number " & Err.Number & " Occurred"
Resume PrintReport_End
End Sub
Sub RestoreReportPrinter()
Dim rpt As Report
Dim prtOld As Printer
Dim prtNew As Printer
' Open the Invoice report in Print Preview.
DoCmd.OpenReport ReportName:="Invoice", View:=acViewPreview
' Initialize rpt variable.
Set rpt = Reports!Invoice
' Save the report's current printer settings
' in the prtOld variable.
Set prtOld = rpt.Printer
' Load the report's current printer settings
' into the prtNew variable.
Set prtNew = rpt.Printer
' Change the report's Orientation property.
prtNew.Orientation = acPRORLandscape
' Change other Printer properties, and then print
' or perform other operations here.
' If you comment out the following line of code,
' and a user interactively closes the report preview
' any changes made to properties of the report's Printer
' object are saved when the report is closed.
Set rpt.Printer = prtOld
' Close report without saving.
DoCmd.Close ObjectType:=acReport, ObjectName:="Invoice",
Save:=acSaveNo
End Sub
Sub GetPaperList()
' Uses DeviceCapabilities API function to display a message box
' with the name of the default printer and a list of
' the papers it supports.
Dim lngPaperCount As Long
Dim lngCounter As Long
Dim hPrinter As Long
Dim strDeviceName As String
Dim strDevicePort As String
Dim strPaperNamesList As String
Dim strPaperName As String
Dim intLength As Integer
Dim strMsg As String
Dim aintNumPaper() As Integer
On Error GoTo GetPaperList_Err
' Get the name and port of the default printer.
strDeviceName = Application.Printer.DeviceName
strDevicePort = Application.Printer.Port
' Get the count of paper names supported by printer.
lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
lpPort:=strDevicePort, _
iIndex:=DC_PAPERNAMES, _
lpOutput:=ByVal vbNullString, _
lpDevMode:=DEFAULT_VALUES)
' Re-dimension the array to the count of paper names.
ReDim aintNumPaper(1 To lngPaperCount)
' Pad the variable to accept 64 bytes for each paper name.
strPaperNamesList = String(64 * lngPaperCount, 0)
' Get the string buffer of all paper names supported by the printer.
lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
lpPort:=strDevicePort, _
iIndex:=DC_PAPERNAMES, _
lpOutput:=ByVal strPaperNamesList, _
lpDevMode:=DEFAULT_VALUES)
' Get the array of all paper numbers supported by the printer.
lngPaperCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
lpPort:=strDevicePort, _
iIndex:=DC_PAPERS, _
lpOutput:=aintNumPaper(1), _
lpDevMode:=DEFAULT_VALUES)
' List the available paper names.
strMsg = "Papers available for " & strDeviceName & vbCrLf
For lngCounter = 1 To lngPaperCount
' Parse a paper name from the string buffer.
strPaperName = Mid(String:=strPaperNamesList, _
Start:=64 * (lngCounter - 1) + 1, Length:=64)
intLength = VBA.InStr(Start:=1, String1:=strPaperName,
String2:=Chr(0)) - 1
strPaperName = Left(String:=strPaperName, Length:=intLength)
' Add a paper number and name to text string for the message
box.
strMsg = strMsg & vbCrLf & aintNumPaper(lngCounter) _
& vbTab & strPaperName
Next lngCounter
' Show the paper names in a message box.
MsgBox Prompt:=strMsg
GetPaperList_End:
Exit Sub
GetPaperList_Err:
MsgBox Prompt:=Err.Description, Buttons:=vbCritical & vbOKOnly, _
Title:="Error Number " & Err.Number & " Occurred"
Resume GetPaperList_End
End Sub
Sub GetBinList(strName As String)
' Uses the DeviceCapabilities API function to display a
' message box with the name of the default printer and a
' list of the paper bins it supports.
Dim lngBinCount As Long
Dim lngCounter As Long
Dim hPrinter As Long
Dim strDeviceName As String
Dim strDevicePort As String
Dim strBinNamesList As String
Dim strBinName As String
Dim intLength As Integer
Dim strMsg As String
Dim aintNumBin() As Integer
On Error GoTo GetBinList_Err
' Get name and port of the default printer.
strDeviceName = Application.Printers(strName).DeviceName
strDevicePort = Application.Printers(strName).Port
' Get count of paper bin names supported by printer.
lngBinCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
lpPort:=strDevicePort, _
iIndex:=DC_BINNAMES, _
lpOutput:=ByVal vbNullString, _
lpDevMode:=DEFAULT_VALUES)
' Re-dimension array to count of paper bins.
ReDim aintNumBin(1 To lngBinCount)
' Pad variable to accept 24 bytes for each bin name.
strBinNamesList = String(Number:=24 * lngBinCount, Character:=0)
' Get string buffer of paper bin names supported by printer.
lngBinCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
lpPort:=strDevicePort, _
iIndex:=DC_BINNAMES, _
lpOutput:=ByVal strBinNamesList, _
lpDevMode:=DEFAULT_VALUES)
' Get array of paper bin numbers supported by printer
lngBinCount = DeviceCapabilities(lpsDeviceName:=strDeviceName, _
lpPort:=strDevicePort, _
iIndex:=DC_BINS, _
lpOutput:=aintNumBin(1), _
lpDevMode:=0)
' List available paper bin names.
strMsg = "Paper bins available for " & strDeviceName & vbCrLf
For lngCounter = 1 To lngBinCount
' Parse a paper bin name from string buffer.
strBinName = Mid(String:=strBinNamesList, _
Start:=24 * (lngCounter - 1) + 1, _
Length:=24)
intLength = VBA.InStr(Start:=1, _
String1:=strBinName, String2:=Chr(0)) - 1
strBinName = Left(String:=strBinName, _
Length:=intLength)
' Add bin name and number to text string for message box.
strMsg = strMsg & vbCrLf & aintNumBin(lngCounter) _
& vbTab & strBinName
Next lngCounter
' Show paper bin numbers and names in message box.
MsgBox Prompt:=strMsg
GetBinList_End:
Exit Sub
GetBinList_Err:
MsgBox Prompt:=Err.Description, Buttons:=vbCritical & vbOKOnly, _
Title:="Error Number " & Err.Number & " Occurred"
Resume GetBinList_End
End Sub
Sub ClearReportSettings()
Dim obj As AccessObject
On Error GoTo ClearReportSettings_Err
' Open each report in the current project, and
' if the report is not using the default printer,
' reset its UseDefaultPrinter property to True.
For Each obj In CurrentProject.AllReports
DoCmd.OpenReport ReportName:=obj.Name, View:=acViewDesign
If Not Reports(obj.Name).UseDefaultPrinter Then
Reports(obj.Name).UseDefaultPrinter = True
DoCmd.Save ObjectType:=acReport, ObjectName:=obj.Name
End If
DoCmd.Close
DoEvents
Next
MsgBox Prompt:="Done!"
ClearReportSettings_End:
Exit Sub
ClearReportSettings_Err:
MsgBox Prompt:=Err.Description, Buttons:=vbCritical & vbOKOnly, _
Title:="Error Number " & Err.Number & " Occurred"
Resume ClearReportSettings_End
End Sub
>>>>>>>>> end msdn code
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Gustav Brock
Sent: Wednesday, February 09, 2005 3:22 AM
To: accessd at databaseadvisors.com
Subject: RE: [AccessD] A97.
Reportwithprinterandpaperselectionpickswrongpaper when deployed on
identica
Hi Steve
Are the media/paper numbers real or hidden?
If I look up the data for PrintMediaReady it contains not a number but a
string with the actual name of the media, like Letter or A4.
/gustav
>>> Developer at UltraDNT.com 08-02-2005 18:13:13 >>>
Right. Lets say invoice paper internally is 123 on your pc, but 149 on
the user's. When you set yours, the application can't find the match at
the user, so the user's pc sets it to 1 (letter). You can write the
correct value to registry, or, I imagine get the right number out of the
registry and just use that in the PRTDEVMODE API - but I havent used
that API in years, I don't remember all the intricacies of it (Its much
easier in Access XP+, with the Printer object). It could eventually fail
though, because the value only lasts until the user deletes the printer,
or deletes the custom paper. If they do that, you have to dig around
for it again.
Steve
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Gustav Brock
Sent: Tuesday, February 08, 2005 11:40 AM
To: accessd at databaseadvisors.com
Subject: RE: [AccessD] A97. Report with
printerandpaperselectionpickswrongpaper when deployed on identica
Hi Steve
That sounds close.
So what you are saying is, that PrintMediaReady at the client initially
contains another media (paper format) than the one we wish to use? And
-
if once corrected, manually or by writing the registry - it will not
fail later?
/gustav
>>> Developer at UltraDNT.com 08-02-2005 17:15:38 >>>
The issue is in the way 2000/XP handles Custom paper.
In Me/98, you only had one custom paper size per machine, represented by
the constant 255. In 2000/XP, there is support for multiple custom
paper sizes, therefore, it is some random number that Windows gives the
custom paper sizes, that can differ from PC to PC, even with apparently
identical setups. On your PC you are assigning a paper-size number that
the client doesn't have, as the default paper, when you set your paper
to Invoice. The client PC defaults to letter because it can't find the
same paper size number as on your PC.
You have to dig in Registry, under:
HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows
NT\CurrentVersion\Print\Printers\<<printer name>>\DsDriver
The PrintMediaSupported key has multiple values. Find Invoice, then use
that as the value for PrintMediaReady.
Or - do what I did - give the user a "Setup" screen.
Steve
--
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com