Solved VBA Code for Printer settings - need updated version (1 Viewer)

GinnyR

New member
Local time
Today, 02:37
Joined
Apr 27, 2023
Messages
24
Hi,
The following code I found on https://www.tek-tips.com/viewthread.cfm?qid=599797 supplied by a programmer Nelviticus. It was back in 2003. I'm using MS Access 2021 and I can't compile this. The first stumbling block is SetPrinterProperty with ActivePrinter with the error 'Variable not defined'. Anyone recognise this? Am I missing a Library Reference? I tried putting 'Application.' before the word Active and also replacing it, but these don't work. Any ideas?

Code:
Private Function SetPrinterProperty(ByVal iPropertyType As Long, _
      ByVal iPropertyValue As Long) As Boolean

   'Code adapted from Microsoft KB article Q230743

    Dim hPrinter As Long          'handle for the current printer
    Dim pd As PRINTER_DEFAULTS
    Dim pinfo As PRINTER_INFO_2
    Dim dm As DEVMODE
    Dim sPrinterName As String

    Dim yDevModeData() As Byte        'Byte array to hold contents
                                      'of DEVMODE structure
    Dim yPInfoMemory() As Byte        'Byte array to hold contents
                                      'of PRINTER_INFO_2 structure
    Dim iBytesNeeded As Long
    Dim iRet As Long
    Dim iJunk As Long
    Dim iCount As Long
     
    On Error GoTo cleanup

    'Get the name of the current printer
    sPrinterName = Trim$(Left$(ActivePrinter, InStr(ActivePrinter, " on "))) 'Ginny
     
    pd.DesiredAccess = PRINTER_NORMAL_ACCESS
    iRet = OpenPrinter(sPrinterName, hPrinter, pd)
    If (iRet = 0) Or (hPrinter = 0) Then
       'Can't access current printer. Bail out doing nothing
       Exit Function
    End If

    'Get the size of the DEVMODE structure to be loaded
    iRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0)
    If (iRet < 0) Then
       'Can't access printer properties.
       GoTo cleanup
    End If

    'Make sure the byte array is large enough
    'Some printer drivers lie about the size of the DEVMODE structure they
    'return, so an extra 100 bytes is provided just in case!
    ReDim yDevModeData(0 To iRet + 100) As Byte
     
    'Load the byte array
    iRet = DocumentProperties(0, hPrinter, sPrinterName, _
                VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
    If (iRet < 0) Then
       GoTo cleanup
    End If

    'Copy the byte array into a structure so it can be manipulated
    Call CopyMemory(dm, yDevModeData(0), Len(dm))

    If dm.dmFields And iPropertyType = 0 Then
       'Wanted property not available. Bail out.
       GoTo cleanup
    End If

    'Set the property to the appropriate value
    Select Case iPropertyType
    Case DM_ORIENTATION
       dm.dmOrientation = iPropertyValue
    Case DM_PAPERSIZE
       dm.dmPaperSize = iPropertyValue
    Case DM_PAPERLENGTH
       dm.dmPaperLength = iPropertyValue
    Case DM_PAPERWIDTH
       dm.dmPaperWidth = iPropertyValue
    Case DM_DEFAULTSOURCE
       dm.dmDefaultSource = iPropertyValue
    Case DM_PRINTQUALITY
       dm.dmPrintQuality = iPropertyValue
    Case DM_COLOR
       dm.dmColor = iPropertyValue
    Case DM_DUPLEX
       dm.dmDuplex = iPropertyValue
    End Select
     
    'Load the structure back into the byte array
    Call CopyMemory(yDevModeData(0), dm, Len(dm))

    'Tell the printer about the new property
    iRet = DocumentProperties(0, hPrinter, sPrinterName, _
          VarPtr(yDevModeData(0)), VarPtr(yDevModeData(0)), _
          DM_IN_BUFFER Or DM_OUT_BUFFER)

    If (iRet < 0) Then
       GoTo cleanup
    End If

    'The code above *ought* to be sufficient to set the property
    'correctly. Unfortunately some brands of Postscript printer don't
    'seem to respond correctly. The following code is used to make
    'sure they also respond correctly.
    Call GetPrinter(hPrinter, 2, 0, 0, iBytesNeeded)
    If (iBytesNeeded = 0) Then
       'Couldn't access shared printer settings
       GoTo cleanup
    End If
     
    'Set byte array large enough for PRINTER_INFO_2 structure
    ReDim yPInfoMemory(0 To iBytesNeeded + 100) As Byte

    'Load the PRINTER_INFO_2 structure into byte array
    iRet = GetPrinter(hPrinter, 2, yPInfoMemory(0), iBytesNeeded, iJunk)
    If (iRet = 0) Then
       'Couldn't access shared printer settings
       GoTo cleanup
    End If

    'Copy byte array into the structured type
    Call CopyMemory(pinfo, yPInfoMemory(0), Len(pinfo))

    'Load the DEVMODE structure with byte array containing
    'the new property value
    pinfo.pDevmode = VarPtr(yDevModeData(0))
     
    'Set security descriptor to null
    pinfo.pSecurityDescriptor = 0
   
    'Copy the PRINTER_INFO_2 structure back into byte array
    Call CopyMemory(yPInfoMemory(0), pinfo, Len(pinfo))

    'Send the new details to the printer
    iRet = SetPrinter(hPrinter, 2, yPInfoMemory(0), 0)

    'Indicate whether it all worked or not!
    SetPrinterProperty = CBool(iRet)

cleanup:
   'Release the printer handle
   If (hPrinter <> 0) Then Call ClosePrinter(hPrinter)
     
   'Flush the message queue. If you don't do this,
   'you can get page fault errors when you try to
   'print a document immediately after setting a printer property.
   For iCount = 1 To 20
      DoEvents
   Next iCount
   End Function
 
ActivePrinter works in Excel VBA.

In Access declare and set a variable to whatever is default (most recent used printer). Example:
Code:
Private Sub btnPrint_Click()
'print to the color printer

Dim strDefaultPrinter As String

'load the current default printer into the variable strDefaultPrinter
strDefaultPrinter = Application.Printer.DeviceName

'switch to Konica printer for color printout
Set Application.Printer = Application.Printers("\\print server\printername")
'try to set printer for color - doesn't work, also tried API coding and that didn't work either
''Application.Printer.ColorMode = acPRCMColor
''Forms("ConcreteMixTools").Printer.ColorMode = acPRCMColor

Me.Detail.BackColor = vbWhite
DoCmd.PrintOut

'change back to default printer
Set Application.Printer = Application.Printers(strDefaultPrinter)

End Sub
 
Last edited:
Its not clear to me what you want your code to do. See if the code in these articles are of any use to you

 
ActivePrinter works in Excel VBA.

In Access declare and set a variable to whatever is default (most recent used printer). Example:
Code:
Private Sub btnPrint_Click()
'print to the color printer

Dim strDefaultPrinter As String

'load the current default printer into the variable strDefaultPrinter
strDefaultPrinter = Application.Printer.DeviceName

'switch to Konica printer for color printout
Set Application.Printer = Application.Printers("\\print server\printername")
'try to set printer for color - doesn't work, also tried API coding and that didn't work either
''Application.Printer.ColorMode = acPRCMColor
''Forms("ConcreteMixTools").Printer.ColorMode = acPRCMColor

Me.Detail.BackColor = vbWhite
DoCmd.PrintOut

'change back to default printer
Set Application.Printer = Application.Printers(strDefaultPrinter)

End Sub
Thanks June7 - it appears this code is for Excel not Access. isladogs has given me pointers to Access coding. Much appreciated
 
Its not clear to me what you want your code to do. See if the code in these articles are of any use to you

Thanks isladogs. I'm having problems with the DoCmd.OutputTo for some reports that I'm exporting to pdf. I have a workaround for these but trying to find shorter coding to manage them. I thought having a printing module might help, but the one I found wouldn't compile in VBA - and you have clarified that it is for Excel not Access. Those articles are helpful. Thanks again - Ginny
 

Users who are viewing this thread

Back
Top Bottom