Using the Windows "printer dialog" API
Bob Howard
I'm using the Windows printer dialog API in an Access module to obtain the
printer device name and number of copies desired to be printed. Basically,
it's working fine.
But when I call it a second time, I want to have the printer previously
selected by the user to be the one pre-selected (rather than the Windows
default printer).
In one attempt to resolve this, I defined the argument structure using
"Static" (rather than Dim). This gave me the desired result regarding the
printer device name, but a problem with the copy count.
The number of copies requested by the user is also remembered!
I tried to fix this by setting the copy count in the dialog's argument
structure to 1 before calling the API, but that didn't fix it. So I then
set the copy count in the DevType extension to the argument structure (which
I retain from call to call) to 1, and that also didn't do it.
Any clue how I can either:
1) Define the argument structure using Static and reset the copy count to
one before calling the API.... or
2) Define the argument structure using Dim and have the dialog open with a
printer that I tell it rather than the Windows default printer.
Thanks!!!
bob
Bob Howard
Professional or later, and needs to work in Access 2003 or later (it's
developed using Access 2003 and distributed as an MDE to the user
locations). Users have either full Access or the Runtime. I've also tested
the application under Access 2010 (32-bit) Runtime and it seems to work.
bob
"Bob Howard" <in...@churchtrax.com> wrote in message
news:OaWKF$a0KHA...@TK2MSFTNGP05.phx.gbl...
Jon Lewis
to hold the printer device name (of the same data type as the relevant
parameter of the Print Dialog structure), set the parameter to the
variable's value before calling the dailog and then set the variable to the
parameter's value after closing the dialog?
-Jon
"Bob Howard" <in...@churchtrax.com> wrote in message
news:OaWKF$a0KHA...@TK2MSFTNGP05.phx.gbl...
Jon Lewis
structure.
Have a look at the PRINTDLG stuff below if you can wade through the all the
other stuff
to see how to retreive, store and reset the printer
Good luck!!
Option Explicit
Private Declare Function CHOOSECOLOR Lib "comdlg32.dll" Alias "ChooseColorA"
(pChoosecolor As CHOOSECOLOR) As Long
Private Declare Function CHOOSEFONT Lib "comdlg32.dll" Alias "ChooseFontA"
(pChoosefont As CHOOSEFONT) As Long
Private Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd
As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As
Long) As Long
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias
"GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function PRINTDLG Lib "comdlg32.dll" Alias "PrintDlgA"
(pPrintdlg As PRINTDLG) As Long
Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long,
ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As
Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As
Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As
Long
Private Declare Function GlobalSize Lib "kernel32" (ByVal hMem As Long) As
Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
(Destination As Any, Source As Any, ByVal Length As Long)
Private Const GMEM_MOVEABLE = &H2
Private Const GMEM_ZEROINIT = &H40
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Private Const LF_FACESIZE = 32
Private Const LF_FULLFACESIZE = 64
Private Const FW_BOLD = 700
Private Const CDERR_DIALOGFAILURE = &HFFFF
Private Const CDERR_FINDRESFAILURE = &H6
Private Const CDERR_GENERALCODES = &H0
Private Const CDERR_INITIALIZATION = &H2
Private Const CDERR_LOADRESFAILURE = &H7
Private Const CDERR_LOADSTRFAILURE = &H5
Private Const CDERR_LOCKRESFAILURE = &H8
Private Const CDERR_MEMALLOCFAILURE = &H9
Private Const CDERR_MEMLOCKFAILURE = &HA
Private Const CDERR_NOHINSTANCE = &H4
Private Const CDERR_NOHOOK = &HB
Private Const CDERR_NOTEMPLATE = &H3
Private Const CDERR_REGISTERMSGFAIL = &HC
Private Const CDERR_STRUCTSIZE = &H1
Private Const FNERR_BUFFERTOOSMALL = &H3003
Private Const FNERR_FILENAMECODES = &H3000
Private Const FNERR_INVALIDFILENAME = &H3002
Private Const FNERR_SUBCLASSFAILURE = &H3001
Private Const DN_DEFAULTPRN = &H1
Private Type CHOOSECOLOR
lStructSize As Long
hwndOwner As Long
hInstance As Long
rgbResult As Long
lpCustColors As Long
flags As Long
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Type LOGFONT
lfHeight As Long
lfWidth As Long
lfEscapement As Long
lfOrientation As Long
lfWeight As Long
lfItalic As Byte
lfUnderline As Byte
lfStrikeOut As Byte
lfCharSet As Byte
lfOutPrecision As Byte
lfClipPrecision As Byte
lfQuality As Byte
lfPitchAndFamily As Byte
lfFaceName(1 To LF_FACESIZE) As Byte
End Type
Private Type CHOOSEFONT
lStructSize As Long
hwndOwner As Long ' caller's window handle
hdc As Long ' printer DC/IC or NULL
lpLogFont As Long
iPointSize As Long ' 10 * size in points of selected font
flags As Long ' enum. type flags
rgbColors As Long ' returned text color
lCustData As Long ' data passed to hook fn.
lpfnHook As Long ' ptr. to hook function
lpTemplateName As String ' custom template name
hInstance As Long ' instance handle of.EXE that
' contains cust. dlg. template
lpszStyle As String ' return the style field here
' must be LF_FACESIZE or bigger
nFontType As Integer ' same value reported to the
EnumFonts
' call back with the extra
FONTTYPE_
' bits added
MISSING_ALIGNMENT As Integer
nSizeMin As Long ' minimum pt size allowed &
nSizeMax As Long ' max pt size allowed if
' CF_LIMITSIZE is used
End Type
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Private Type PRINTDLG
lStructSize As Long
hwndOwner As Long
hDevMode As Long
hDevNames As Long
hdc As Long
flags As Long
nFromPage As Integer
nToPage As Integer
nMinPage As Integer
nMaxPage As Integer
nCopies As Integer
hInstance As Long
lCustData As Long
lpfnPrintHook As Long
lpfnSetupHook As Long
lpPrintTemplateName As String
lpSetupTemplateName As String
hPrintTemplate As Long
hSetupTemplate As Long
End Type
Private Type DEVNAMES
wDriverOffset As Integer
wDeviceOffset As Integer
wOutputOffset As Integer
wDefault As Integer
End Type
Public Enum HelpCmdEnum
HELP_COMMAND = &H102&
HELP_CONTENTS = &H3&
HELP_CONTEXT = &H1
HELP_CONTEXTPOPUP = &H8&
HELP_FORCEFILE = &H9&
HELP_HELPONHELP = &H4
HELP_INDEX = &H3
HELP_KEY = &H101
HELP_MULTIKEY = &H201&
HELP_PARTIALKEY = &H105&
HELP_QUIT = &H2
HELP_SETCONTENTS = &H5&
HELP_SETINDEX = &H5
HELP_SETWINPOS = &H203&
HELP_FINDER = &HB&
End Enum
Public Enum FontFlagsEnum
CF_ANSIONLY = &H400&
CF_APPLY = &H200&
CF_BOTH = &H3
CF_EFFECTS = &H100&
CF_TTONLY = &H40000
CF_FIXEDPITCHONLY = &H4000&
CF_FORCEFONTEXIST = &H10000
CF_INITTOLOGFONTSTRUCT = &H40&
CF_LIMITSIZE = &H2000&
CF_WYSIWYG = &H8000
CF_NOFACESEL = &H80000
CF_NOOEMFONTS = &H800&
CF_NOSCRIPTSEL = &H800000
CF_NOSIMULATIONS = &H1000&
CF_NOSIZESEL = &H200000
CF_NOSTYLESEL = &H100000
CF_NOVECTORFONTS = &H800&
CF_NOVERTFONTS = &H1000000
CF_SCREENFONTS = &H1
CF_PRINTERFONTS = &H2
CF_SCRIPTSONLY = &H400&
CF_SCALABLEONLY = &H20000
CF_SELECTSCRIPT = &H400000
CF_SHOWHELP = &H4&
CF_USESTYLE = &H80&
End Enum
'internal property buffers
Private iAction As Integer 'internal buffer for Action property
Private bCancelError As Boolean 'internal buffer for CancelError property
Private lColor As Long 'internal buffer for Color property
Private lCopies As Long 'internal buffer for lCopies property
Private sDefaultExt As String 'internal buffer for sDefaultExt property
Private sDialogTitle As String 'internal buffer for DialogTitle property
Private sFileName As String 'internal buffer for FileName property
Private sFileTitle As String 'internal buffer for FileTitle property
Private sFilter As String 'internal buffer for Filter property
Private iFilterIndex As Integer 'internal buffer for FilterIndex property
Private lFlags As Long 'internal buffer for Flags property
Private bFontBold As Boolean 'internal buffer for FontBold property
Private bFontItalic As Boolean 'internal buffer for FontItalic property
Private sFontName As String 'internal buffer for FontName property
Private lFontSize As Long 'internal buffer for FontSize property
Private bFontStrikethru As Boolean 'internal buffer for FontStrikethru
property
Private bFontUnderline As Boolean 'internal buffer for FontUnderline
property
Private lFromPage As Long 'internal buffer for FromPage property
Private lhwnd As Long 'internal buffer for hdc property
Private lhdc As Long 'internal buffer for hdc property
Private lHelpCommand As Long 'internal buffer for HelpCommand property
Private sHelpData As String 'internal buffer for HelpContext property
Private sHelpFile As String 'internal buffer for HelpFile property
Private sHelpKey As String 'internal buffer for HelpKey property
Private sInitDir As String 'internal buffer for InitDir property
Private lMax As Long 'internal buffer for Max property
Private lMaxFileSize As Long 'internal buffer for MaxFileSize property
Private lMin As Long 'internal buffer for Min property
Private objObject As Object 'internal buffer for Object property
Private iPrinterDefault As Integer 'internal buffer for PrinterDefault
property
Private lToPage As Long 'internal buffer for ToPage property
Private lDeviceName As String 'internal buffer for DeviceName property
Private lDriverName As String 'internal buffer for DriverName property
Private lPort As String 'internal buffer for Port property
Private lApiReturn As Long 'internal buffer for APIReturn property
Private lExtendedError As Long 'internal buffer for ExtendedError
property
Private lCancelled As Boolean 'internal buffer for Cancelled property
Public Property Get Filter() As String
'return object's Filter property
Filter = sFilter
End Property
Public Sub ShowColor()
'display the color dialog box
Dim tChooseColor As CHOOSECOLOR
Dim alCustomColors(15) As Long
Dim lCustomColorSize As Long
Dim lCustomColorAddress As Long
Dim lMemHandle As Long
Dim n As Integer
On Error GoTo ShowColorError
'*** init property buffers
iAction = 3 'Action property - ShowColor
lApiReturn = 0 'APIReturn property
lExtendedError = 0 'ExtendedError property
'*** prepare tChooseColor data
'lStructSize As Long
tChooseColor.lStructSize = Len(tChooseColor)
'hwndOwner As Long
tChooseColor.hwndOwner = lhwnd
'hInstance As Long
'rgbResult As Long
tChooseColor.rgbResult = lColor
'lpCustColors As Long
' Fill custom colors array with all white
For n = 0 To UBound(alCustomColors)
alCustomColors(n) = &HFFFFFF
Next
' Get size of memory needed for custom colors
lCustomColorSize = Len(alCustomColors(0)) * 16
' Get a global memory block to hold a copy of the custom colors
lMemHandle = GlobalAlloc(GHND, lCustomColorSize)
If lMemHandle = 0 Then
Exit Sub
End If
' Lock the custom color's global memory block
lCustomColorAddress = GlobalLock(lMemHandle)
If lCustomColorAddress = 0 Then
Exit Sub
End If
' Copy custom colors to the global memory block
Call CopyMemory(ByVal lCustomColorAddress, alCustomColors(0),
lCustomColorSize)
tChooseColor.lpCustColors = lCustomColorAddress
'flags As Long
tChooseColor.flags = lFlags
'lCustData As Long
'lpfnHook As Long
'lpTemplateName As String
'*** call the ChooseColor API function
lApiReturn = CHOOSECOLOR(tChooseColor)
'*** handle return from ChooseColor API function
Select Case lApiReturn
Case 0 'user canceled
If bCancelError = True Then
'generate an error
On Error GoTo 0
Err.Raise Number:=vbObjectError + 894, _
Description:="Cancel Pressed"
Exit Sub
End If
Case 1 'user selected a color
'update property buffer
lColor = tChooseColor.rgbResult
Case Else 'an error occured
'call CommDlgExtendedError
lExtendedError = CommDlgExtendedError
End Select
Exit Sub
ShowColorError:
Exit Sub
End Sub
Public Sub ShowFont()
'display the font dialog box
Dim tLogFont As LOGFONT
Dim tChooseFont As CHOOSEFONT
Dim lLogFontSize As Long
Dim lLogFontAddress As Long
Dim lMemHandle As Long
On Error GoTo ShowFontError
'*** init property buffers
iAction = 4 'Action property - ShowFont
lApiReturn = 0 'APIReturn property
lExtendedError = 0 'ExtendedError property
'*** prepare tChooseFont data
'tLogFont.lfHeight As Long
'tLogFont.lfWidth As Long
'tLogFont.lfEscapement As Long
'tLogFont.lfOrientation As Long
'tLogFont.lfWeight As Long - init from FontBold property
If bFontBold = True Then
tLogFont.lfWeight = FW_BOLD
End If
'tLogFont.lfItalic As Byte - init from FontItalic property
If bFontItalic = True Then
tLogFont.lfItalic = 1
End If
'tLogFont.lfUnderline As Byte - init from FontUnderline property
If bFontUnderline = True Then
tLogFont.lfUnderline = 1
End If
'tLogFont.lfStrikeOut As Byte - init from FontStrikethru property
If bFontStrikethru = True Then
tLogFont.lfStrikeOut = 1
End If
'tLogFont.lfCharSet As Byte
'tLogFont.lfOutPrecision As Byte
'tLogFont.lfClipPrecision As Byte
'tLogFont.lfQuality As Byte
'tLogFont.lfPitchAndFamily As Byte
'tLogFont.lfFaceName(LF_FACESIZE) As Byte
'tChooseFont.lStructSize As Long
tChooseFont.lStructSize = Len(tChooseFont)
'tChooseFont.hwndOwner As Long
'tChooseFont.hdc As Long
'tChooseFont.lpLogFont As Long
lLogFontSize = Len(tLogFont)
' Get a global memory block to hold a copy of tLogFont - exit on failure
lMemHandle = GlobalAlloc(GHND, lLogFontSize)
If lMemHandle = 0 Then
Exit Sub
End If
' Lock tLogFont's global memory block - exit on failure
lLogFontAddress = GlobalLock(lMemHandle)
If lLogFontAddress = 0 Then
Exit Sub
End If
' Copy tLogFont to the global memory block
Call CopyMemory(ByVal lLogFontAddress, tLogFont, lLogFontSize)
tChooseFont.lpLogFont = lLogFontAddress
'tChooseFont.iPointSize As Long - init from FontSize property
tChooseFont.iPointSize = lFontSize * 10
'tChooseFont.flags As Long - init from Flags property
tChooseFont.flags = lFlags
'tChooseFont.rgbColors As Long
'tChooseFont.lCustData As Long
'tChooseFont.lpfnHook As Long
'tChooseFont.lpTemplateName As String
'tChooseFont.hInstance As Long
'tChooseFont.lpszStyle As String
'sFont = Chr$(0) & Space$(20) & Chr$(0)
'tChooseFont.lpszStyle = sFont
'tChooseFont.nFontType As Integer
'tChooseFont.MISSING_ALIGNMENT As Integer
'tChooseFont.nSizeMin As Long
'tChooseFont.nSizeMax As Long
'*** call the CHOOSEFONT API function
lApiReturn = CHOOSEFONT(tChooseFont) 'store to APIReturn property
'*** handle return from CHOOSEFONT API function
Select Case lApiReturn
Case 0 'user canceled
If bCancelError = True Then
'generate an error
Err.Raise (2001)
Exit Sub
End If
Case 1 'user selected a font
' Copy global memory block to tLogFont
Call CopyMemory(tLogFont, ByVal lLogFontAddress, lLogFontSize)
'tLogFont.lfWeight As Long - store to FontBold property
If tLogFont.lfWeight >= FW_BOLD Then
bFontBold = True
Else
bFontBold = False
End If
'tLogFont.lfItalic As Byte - store to FontItalic property
If tLogFont.lfItalic = 1 Then
bFontItalic = True
Else
bFontItalic = False
End If
'tLogFont.lfUnderline As Byte - store to FontUnderline property
If tLogFont.lfUnderline = 1 Then
bFontUnderline = True
Else
bFontUnderline = False
End If
'tLogFont.lfStrikeOut As Byte - store to FontStrikethru property
If tLogFont.lfStrikeOut = 1 Then
bFontStrikethru = True
Else
bFontStrikethru = False
End If
'tLogFont.lfFaceName(LF_FACESIZE) As Byte - store to FontName
property
FontName = sByteArrayToString(tLogFont.lfFaceName())
'tChooseFont.iPointSize As Long - store to FontSize property
lFontSize = CLng(tChooseFont.iPointSize / 10)
Case Else 'an error occured
'call CommDlgExtendedError
lExtendedError = CommDlgExtendedError 'store to ExtendedError
property
End Select
Exit Sub
ShowFontError:
Exit Sub
End Sub
Public Sub ShowHelp()
'run winhelp.exe with the specified help file
Dim sHelpFileBuff As String
Dim lData As Long
On Error GoTo ShowHelpError
'*** init Private properties
iAction = 6 'Action property - ShowHelp
lApiReturn = 0 'APIReturn property
lExtendedError = 0 'ExtendedError property
'*** prepare the buffers and parameters for the API function
'sHelpFile is a null terminated string
sHelpFileBuff = sHelpFile & Chr$(0)
'sData is dependent on lHelpCommand
Select Case lHelpCommand
Case 0
lData = 0
Case Else
lData = sHelpData
End Select
'*** call the API function
lApiReturn = WinHelp(lhwnd, sHelpFile, lHelpCommand, lData) ' - Store
to APIReturn property
Select Case lApiReturn
Case 0 '
'call CommDlgExtendedError
lExtendedError = CommDlgExtendedError ' - store to
ExtendedError property
Case Else '
'call CommDlgExtendedError
lExtendedError = CommDlgExtendedError
End Select
Exit Sub
ShowHelpError:
Exit Sub
End Sub
Public Sub ShowOpen()
'display the file open dialog box
ShowFileDialog (1) 'Action property - ShowOpen
End Sub
Public Sub ShowPrinter()
'display the print dialog
Dim tPrintDlg As PRINTDLG
Dim tDevNames As DEVNAMES
Dim p As Long
Dim n As Long
Dim s As String
Dim h As Integer
On Error GoTo ShowPrinterError
'*** init public properties
iAction = 5 'Action property - ShowPrint
lApiReturn = 0 'APIReturn property
lExtendedError = 0 'ExtendedError property
lCancelled = True 'Cancelled property
'*** prepare tPrintDlg data
'lStructSize As Long
tPrintDlg.lStructSize = Len(tPrintDlg)
'hwndOwner As Long
'hDevMode As Long
tPrintDlg.hDevMode = 0
'hDevNames As Long - init from DeviceName, DriverName & Port properties
If lDeviceName = "" Then
h = 0
Else
s = lDriverName & Chr$(0) & lDeviceName & Chr$(0) & lPort & Chr$(0)
tDevNames.wDriverOffset = Len(tDevNames)
tDevNames.wDeviceOffset = tDevNames.wDriverOffset + Len(lDriverName)
+ 1
tDevNames.wOutputOffset = tDevNames.wDeviceOffset + Len(lDeviceName)
+ 1
tDevNames.wDefault = 0
h = GlobalAlloc(GHND, Len(tDevNames) + Len(s))
If h <> 0 Then
p = GlobalLock(h)
Call CopyMemory(ByVal p, tDevNames, Len(tDevNames))
p = p + Len(tDevNames)
Call CopyMemory(ByVal p, ByVal s, Len(s))
Call GlobalUnlock(h)
End If
End If
tPrintDlg.hDevNames = h
'hdc As Long - init from hDC property
tPrintDlg.hdc = lhdc
'flags As Long - init from Flags property
tPrintDlg.flags = lFlags
'nFromPage As Integer - init from FromPage property
tPrintDlg.nFromPage = lFromPage
'nToPage As Integer - init from ToPage property
tPrintDlg.nToPage = lToPage
'nMinPage As Integer - init from Min property
tPrintDlg.nMinPage = lMin
'nMaxPage As Integer - init from Max property
tPrintDlg.nMaxPage = lMax
'nCopies As Integer - init from Copies property
tPrintDlg.nCopies = lCopies
'hInstance As Long
'lCustData As Long
'*** Call the PrintDlg API function
lApiReturn = PRINTDLG(tPrintDlg)
'*** handle return from PrintDlg API function
Select Case lApiReturn
Case 0 'user canceled
If bCancelError = True Then
'generate an error
Err.Raise (2001)
Exit Sub
End If
Case 1 'user selected OK
'nFromPage As Integer - store to FromPage property
lFromPage = tPrintDlg.nFromPage
'nToPage As Integer - store to ToPage property
lToPage = tPrintDlg.nToPage
'nMinPage As Integer - store to Min property
lMin = tPrintDlg.nMinPage
'nMaxPage As Integer - store to Max property
lMax = tPrintDlg.nMaxPage
'nCopies As Integer - store to Copies property
lCopies = tPrintDlg.nCopies
'copy devname, driver & output fields of DEVNAMES
n = GlobalSize(tPrintDlg.hDevNames)
p = GlobalLock(tPrintDlg.hDevNames)
Call CopyMemory(tDevNames, ByVal p, Len(tDevNames))
s = String$(n, 0)
Call CopyMemory(ByVal s, ByVal p, n)
Call GlobalUnlock(tPrintDlg.hDevNames)
' Call GlobalFree(tPrintDlg.hDevNames)
lDeviceName = sLeftOfNull(Mid$(s, tDevNames.wDeviceOffset + 1))
lDriverName = sLeftOfNull(Mid$(s, tDevNames.wDriverOffset + 1))
lPort = sLeftOfNull(Mid$(s, tDevNames.wOutputOffset + 1))
lCancelled = False
Case Else 'an error occured
'call CommDlgExtendedError
lExtendedError = CommDlgExtendedError 'store to ExtendedError
property
End Select
Exit Sub
ShowPrinterError:
If Err = 2001 Then Resume Next
Exit Sub
End Sub
Public Sub ShowSave()
'display the file save dialog box
ShowFileDialog (2) 'Action property - ShowSave
End Sub
Public Property Get FileName() As String
'return object's FileName property
FileName = sFileName
End Property
Public Property Let FileName(vNewValue As String)
'assign object's FileName property
sFileName = vNewValue
End Property
Public Property Let Filter(vNewValue As String)
'assign object's Filter property
sFilter = vNewValue
End Property
Private Function sLeftOfNull(ByVal sIn As String)
'returns the part of sIn preceding Chr$(0)
Dim lNullPos As Long
'init output
sLeftOfNull = sIn
'get position of first Chr$(0) in sIn
lNullPos = InStr(sIn, Chr$(0))
'return part of sIn to left of first Chr$(0) if found
If lNullPos > 0 Then
sLeftOfNull = Mid$(sIn, 1, lNullPos - 1)
End If
End Function
Public Property Get Action() As Integer
'Return object's Action property
Action = iAction
End Property
Private Function sAPIFilter(sIn)
'prepares sIn for use as a filter string in API common dialog functions
Dim lChrNdx As Long
Dim sOneChr As String
Dim sOutStr As String
'convert any | characters to nulls
For lChrNdx = 1 To Len(sIn)
sOneChr = Mid$(sIn, lChrNdx, 1)
If sOneChr = "|" Then
sOutStr = sOutStr & Chr$(0)
Else
sOutStr = sOutStr & sOneChr
End If
Next
'add a null to the end
sOutStr = sOutStr & Chr$(0)
'return sOutStr
sAPIFilter = sOutStr
End Function
Public Property Get FilterIndex() As Integer
'return object's FilterIndex property
FilterIndex = iFilterIndex
End Property
Public Property Let FilterIndex(vNewValue As Integer)
iFilterIndex = vNewValue
End Property
Public Property Get CancelError() As Boolean
'Return object's CancelError property
CancelError = bCancelError
End Property
Public Property Let CancelError(vNewValue As Boolean)
'Assign object's CancelError property
bCancelError = vNewValue
End Property
Public Property Get Color() As Long
'return object's Color property
Color = lColor
End Property
Public Property Let Color(vNewValue As Long)
'assign object's Color property
lColor = vNewValue
End Property
Public Property Get Copies() As Long
'return object's Copies property
Copies = lCopies
End Property
Public Property Let Copies(vNewValue As Long)
'assign object's Copies property
lCopies = vNewValue
End Property
Public Property Get DefaultExt() As String
'return object's DefaultExt property
DefaultExt = sDefaultExt
End Property
Public Property Let DefaultExt(vNewValue As String)
'assign object's DefaultExt property
sDefaultExt = vNewValue
End Property
Public Property Get DialogTitle() As String
'return object's FileName property
DialogTitle = sDialogTitle
End Property
Public Property Let DialogTitle(vNewValue As String)
'assign object's DialogTitle property
sDialogTitle = vNewValue
End Property
Public Property Get flags() As Long
'return object's Flags property
flags = lFlags
End Property
Public Property Let flags(vNewValue As Long)
'assign object's Flags property
lFlags = vNewValue
End Property
Public Property Get FontBold() As Boolean
'return object's FontBold property
FontBold = bFontBold
End Property
Public Property Let FontBold(vNewValue As Boolean)
'Assign object's FontBold property
bFontBold = vNewValue
End Property
Public Property Get FontItalic() As Boolean
'Return object's FontItalic property
FontItalic = bFontItalic
End Property
Public Property Let FontItalic(vNewValue As Boolean)
'Assign object's FontItalic property
bFontItalic = vNewValue
End Property
Public Property Get FontName() As String
'Return object's Fontname property
FontName = sFontName
End Property
Public Property Let FontName(vNewValue As String)
'Assign object's FontName property
sFontName = vNewValue
End Property
Public Property Get FontSize() As Long
'Return object's FontSize property
FontSize = lFontSize
End Property
Public Property Let FontSize(vNewValue As Long)
'Assign object's FontSize property
lFontSize = vNewValue
End Property
Public Property Get FontStrikethru() As Boolean
'Return object's FontStrikethru property
FontStrikethru = bFontStrikethru
End Property
Public Property Let FontStrikethru(vNewValue As Boolean)
'Assign object's - property
bFontStrikethru = vNewValue
End Property
Public Property Get FontUnderline() As Boolean
'Return object's FontUnderline property
FontUnderline = bFontUnderline
End Property
Public Property Let FontUnderline(vNewValue As Boolean)
'Assign object's FontUnderline property
bFontUnderline = vNewValue
End Property
Public Property Get FromPage() As Long
'Return object's FromPAge property
FromPage = lFromPage
End Property
Public Property Let FromPage(vNewValue As Long)
'Assign object's FromPage property
lFromPage = vNewValue
End Property
Public Property Get hwnd() As Long
On Error GoTo Fail
'Return object's hWND property
hwnd = lhwnd
Exit Property
Fail:
ErrReport.AddToStackRaiseError TypeName(Me), "hWnd[GET]"
End Property
Public Property Let hwnd(vNewValue As Long)
On Error GoTo Fail
'Assign object's hWND property
lhwnd = vNewValue
Exit Property
Fail:
ErrReport.AddToStackRaiseError TypeName(Me), "hWnd[LET]"
End Property
Public Property Get hdc() As Long
On Error GoTo Fail
'Return object's hDC property
hdc = lhdc
Exit Property
Fail:
ErrReport.AddToStackRaiseError TypeName(Me), "hDC[GET]"
End Property
Public Property Let hdc(vNewValue As Long)
On Error GoTo Fail
'Assign object's hDC property
lhdc = vNewValue
Exit Property
Fail:
ErrReport.AddToStackRaiseError TypeName(Me), "hDC[LET]"
End Property
Public Property Get HelpCommand() As HelpCmdEnum
'Return object's HelpCommand property
HelpCommand = lHelpCommand
End Property
Public Property Let HelpCommand(vNewValue As HelpCmdEnum)
'Assign object's HelpCommand property
lHelpCommand = vNewValue
End Property
Public Property Get HelpData() As String
'Return object's HelpContext property
HelpData = sHelpData
End Property
Public Property Let HelpData(vNewValue As String)
'Assign object's HelpContext property
sHelpData = vNewValue
End Property
Public Property Get HelpFile() As String
'Return object's HelpFile property
HelpFile = sHelpFile
End Property
Public Property Let HelpFile(vNewValue As String)
'Assign object's HelpFile property
sHelpFile = vNewValue
End Property
Public Property Get HelpKey() As String
'Return object's HelpKey property
HelpKey = sHelpKey
End Property
Public Property Let HelpKey(vNewValue As String)
'Assign object's HelpKey property
sHelpKey = vNewValue
End Property
Public Property Get InitDir() As String
'Return object's InitDir property
InitDir = sInitDir
End Property
Public Property Let InitDir(vNewValue As String)
'Assign object's InitDir property
sInitDir = vNewValue
End Property
Public Property Get Max() As Long
'Return object's Max property
Max = lMax
End Property
Public Property Let Max(vNewValue As Long)
'Assign object's - property
lMax = vNewValue
End Property
Public Property Get MaxFileSize() As Long
'Return object's MaxFileSize property
MaxFileSize = lMaxFileSize
End Property
Public Property Let MaxFileSize(vNewValue As Long)
'Assign object's MaxFileSize property
lMaxFileSize = vNewValue
End Property
Public Property Get Min() As Long
'Return object's Min property
Min = lMin
End Property
Public Property Let Min(vNewValue As Long)
'Assign object's Min property
lMin = vNewValue
End Property
Public Property Get Object() As Object
'Return object's Object property
Object = objObject
End Property
Public Property Let Object(vNewValue As Object)
'Assign object's Object property
objObject = vNewValue
End Property
Public Property Get PrinterDefault() As Integer
'Return object's PrinterDefault property
PrinterDefault = iPrinterDefault
End Property
Public Property Let PrinterDefault(vNewValue As Integer)
'Assign object's PrinterDefault property
iPrinterDefault = vNewValue
End Property
Public Property Get ToPage() As Long
'Return object's ToPage property
ToPage = lToPage
End Property
Public Property Let ToPage(vNewValue As Long)
'Assign object's ToPage property
lToPage = vNewValue
End Property
Public Property Get FileTitle() As String
'return object's FileTitle property
FileTitle = sFileTitle
End Property
Public Property Let FileTitle(vNewValue As String)
'assign object's FileTitle property
sFileTitle = vNewValue
End Property
Public Property Get APIReturn() As Long
'return object's APIReturn property
APIReturn = lApiReturn
End Property
Public Property Get ExtendedError() As Long
'return object's ExtendedError property
ExtendedError = lExtendedError
End Property
Private Function sByteArrayToString(abBytes() As Byte) As String
'return a string from a byte array
Dim lBytePoint As Long
Dim lByteVal As Long
Dim sOut As String
'init array pointer
lBytePoint = LBound(abBytes)
'fill sOut with characters in array
While lBytePoint <= UBound(abBytes)
lByteVal = abBytes(lBytePoint)
'return sOut and stop if Chr$(0) is encountered
If lByteVal = 0 Then
sByteArrayToString = sOut
Exit Function
Else
sOut = sOut & Chr$(lByteVal)
End If
lBytePoint = lBytePoint + 1
Wend
'return sOut if Chr$(0) wasn't encountered
sByteArrayToString = sOut
End Function
Private Sub ShowFileDialog(ByVal iAction As Integer)
'display the file dialog for ShowOpen or ShowSave
Dim tOpenFile As OPENFILENAME
' Dim lMaxSize As Long
Dim sFileNameBuff As String
Dim sFileTitleBuff As String
On Error GoTo ShowFileDialogError
'*** init property buffers
iAction = iAction 'Action property
lApiReturn = 0 'APIReturn property
lExtendedError = 0 'ExtendedError property
lCancelled = True 'Cancelled property
'*** prepare tOpenFile data
'tOpenFile.lStructSize As Long
tOpenFile.lStructSize = Len(tOpenFile)
'tOpenFile.hWndOwner As Long - init from hdc property
tOpenFile.hwndOwner = lhwnd
'tOpenFile.lpstrFilter As String - init from Filter property
tOpenFile.lpstrFilter = sAPIFilter(sFilter)
'tOpenFile.iFilterIndex As Long - init from FilterIndex property
tOpenFile.nFilterIndex = iFilterIndex
'tOpenFile.lpstrFile As String - init from FileName property
'prepare sFileNameBuff
sFileNameBuff = Pad(sFileName & Chr$(0), lMaxFileSize)
tOpenFile.lpstrFile = sFileNameBuff
'nMaxFile As Long - init from MaxFileSize property
tOpenFile.nMaxFile = lMaxFileSize
'lpstrFileTitle As String - init from FileTitle property
'prepare sFileTitleBuff
sFileTitleBuff = Pad(sFileTitle & Chr$(0), lMaxFileSize)
tOpenFile.lpstrFileTitle = sFileTitleBuff
'nMaxFileTitle As Long - init from MaxFileSize property
tOpenFile.nMaxFileTitle = lMaxFileSize
'tOpenFile.lpstrInitialDir As String - init from InitDir property
tOpenFile.lpstrInitialDir = sInitDir
'tOpenFile.lpstrTitle As String - init from DialogTitle property
tOpenFile.lpstrTitle = sDialogTitle
'tOpenFile.flags As Long - init from Flags property
tOpenFile.flags = lFlags
'tOpenFile.lpstrDefExt As String - init from DefaultExt property
tOpenFile.lpstrDefExt = sDefaultExt
'*** call the GetOpenFileName API function
Select Case iAction
Case 1 'ShowOpen
lApiReturn = GetOpenFileName(tOpenFile)
Case 2 'ShowSave
lApiReturn = GetSaveFileName(tOpenFile)
Case Else 'unknown action
Exit Sub
End Select
'*** handle return from GetOpenFileName API function
Select Case lApiReturn
Case 0 'user canceled
If bCancelError = True Then
'generate an error
Err.Raise (2001)
Exit Sub
End If
Case 1 'user selected or entered a file
'sFileName gets part of tOpenFile.lpstrFile to the left of first
Chr$(0)
sFileName = sLeftOfNull(tOpenFile.lpstrFile)
sFileTitle = sLeftOfNull(tOpenFile.lpstrFileTitle)
lCancelled = False
Case Else 'an error occured
'call CommDlgExtendedError
lExtendedError = CommDlgExtendedError
End Select
Exit Sub
ShowFileDialogError:
Exit Sub
End Sub
Public Property Get DeviceName() As String
DeviceName = lDeviceName
End Property
Public Property Let DeviceName(vNewValue As String)
lDeviceName = vNewValue
End Property
Public Property Get DriverName() As String
DriverName = lDriverName
End Property
Public Property Let DriverName(vNewValue As String)
lDriverName = vNewValue
End Property
Public Property Get Port() As String
Port = lPort
End Property
Public Property Let Port(vNewValue As String)
lPort = vNewValue
End Property
Private Sub Class_Initialize()
lMaxFileSize = 256
lCopies = 1
End Sub
Private Function Pad(s As String, w As Long) As String
If Len(s) > w Then
Pad = Left$(s, w)
Else
Pad = s + Space$(w - Len(s))
End If
End Function
Public Property Get Cancelled() As Boolean
Cancelled = lCancelled
End Property
"Bob Howard" <in...@churchtrax.com> wrote in message
news:OaWKF$a0KHA...@TK2MSFTNGP05.phx.gbl...
Bob Howard
from work). The "answer" is in the DevNames structure ... I know that for
sure. Anyway ... will get back with you... bob
"Jon Lewis" <jon....@cutthespambtinternet.com> wrote in message
news:%23fJ3sJc...@TK2MSFTNGP04.phx.gbl...
Bob Howard
get into and unsnarl. I think I'll just keep poking around and see what I
can do. bob
"Jon Lewis" <jon....@cutthespambtinternet.com> wrote in message
news:%23fJ3sJc...@TK2MSFTNGP04.phx.gbl...
Bob Howard
I eventually got it to work by building a prototype Devmode and DevNames
structure hung off the PrintDlg structure. I was able to set my default
values in those structures before opening the print dialog. It appears
everything's working now. In my testing, I also noted that I needed to use
the "long printer name" returned in the DevNames structure and not the
32-byte short name returned in the DevMode structure. This was very obvious
when I tested using a network printer ... since it's name far exceeded 32
bytes. bob
"Jon Lewis" <jon....@cutthespambtinternet.com> wrote in message
news:%23fJ3sJc...@TK2MSFTNGP04.phx.gbl...
Francisco Flores
I am having problems with mine.
I will really appreciate it.
Thank you
Francisco
> On Thursday, April 01, 2010 11:27 AM Bob Howard wrote:
> Hi...
>
> I am using the Windows printer dialog API in an Access module to obtain the
> printer device name and number of copies desired to be printed. Basically,
> it is working fine.
>
> But when I call it a second time, I want to have the printer previously
> selected by the user to be the one pre-selected (rather than the Windows
> default printer).
>
> In one attempt to resolve this, I defined the argument structure using
> "Static" (rather than Dim). This gave me the desired result regarding the
> printer device name, but a problem with the copy count.
>
> The number of copies requested by the user is also remembered!
>
> I tried to fix this by setting the copy count in the dialog's argument
> structure to 1 before calling the API, but that did not fix it. So I then
> set the copy count in the DevType extension to the argument structure (which
> I retain from call to call) to 1, and that also did not do it.
>
> Any clue how I can either:
>
> 1) Define the argument structure using Static and reset the copy count to
> one before calling the API.... or
> 2) Define the argument structure using Dim and have the dialog open with a
> printer that I tell it rather than the Windows default printer.
>
> Thanks!!!
>
> bob
>> On Thursday, April 01, 2010 12:09 PM Bob Howard wrote:
>> I should have mentioned that the result needs to work in Windows 2000
>> Professional or later, and needs to work in Access 2003 or later (it is
>> developed using Access 2003 and distributed as an MDE to the user
>> locations). Users have either full Access or the Runtime. I have also tested
>> the application under Access 2010 (32-bit) Runtime and it seems to work.
>> bob
>>> On Thursday, April 01, 2010 12:23 PM Jon Lewis wrote:
>>> Difficult without seeing your code but can you not declare a Static variable
>>> to hold the printer device name (of the same data type as the relevant
>>> parameter of the Print Dialog structure), set the parameter to the
>>> variable's value before calling the dailog and then set the variable to the
>>> parameter's value after closing the dialog?
>>>
>>> -Jon
>>>> On Thursday, April 01, 2010 1:40 PM Jon Lewis wrote:
>>>> Just remembered it is a bit more complex than this with the DevNames
>>>>> On Thursday, April 01, 2010 7:10 PM Bob Howard wrote:
>>>>> Thanks ... I will check this out when I have a real clear head (just got back
>>>>> from work). The "answer" is in the DevNames structure ... I know that for
>>>>> sure. Anyway ... will get back with you... bob
>>>>>> On Friday, April 02, 2010 11:06 AM Bob Howard wrote:
>>>>>> Jon. Thanks for the help, but the code you sent is way too deep for me to
>>>>>> get into and unsnarl. I think I will just keep poking around and see what I
>>>>>> can do. bob
>>>>>>> On Sunday, April 04, 2010 9:39 PM Bob Howard wrote:
>>>>>>> Hi again...
>>>>>>>
>>>>>>> I eventually got it to work by building a prototype Devmode and DevNames
>>>>>>> structure hung off the PrintDlg structure. I was able to set my default
>>>>>>> values in those structures before opening the print dialog. It appears
>>>>>>> everything is working now. In my testing, I also noted that I needed to use
>>>>>>> the "long printer name" returned in the DevNames structure and not the
>>>>>>> 32-byte short name returned in the DevMode structure. This was very obvious
>>>>>>> when I tested using a network printer ... since it is name far exceeded 32
>>>>>>> bytes. bob
>>>>>>> Submitted via EggHeadCafe - Software Developer Portal of Choice
>>>>>>> MongoDb vs SQL Server Basic Speed Tests
>>>>>>> http://www.eggheadcafe.com/tutorials/aspnet/6f573869-c8eb-40c3-9946-2f61e0163966/mongodb-vs-sql-server-basic-speed-tests.aspx