Does anybody have vba code for macros to PrintDuplex4up PrintSimplex1up

Hi Rob,
Long time, no see!  

I am providing the following as a FYI.  I can vouch that Lebans report utility #5 worked on the Access 2K platform when I checked it out many years ago.......I can't vouch that it will work on the excel platform with or without modification.  Hope this info helps you out.
 
http://www.lebans.com/ReportUtilities.htm
 (Look at the fifth of five utilities)

akoster's advice seems simplest.  I will try it when I get to work today and report back this afternoon. If it works as I expect, I think my vba macros will contain about 5 lines of code.

akoster's.  That almost works, but not quite. I created 2 printers name HP4UpDuplex and HP1UpSimplex.  I then printed mydocA to Hp4UpDuplex and manually set the propertities to be 4up duplex.  I also printed myDocA to HP1UpSimplex.  Everything looked great. Depending on which printer I used, it would print either 1up simplex or 4up duplex.

The macro was dirt simple
sub PrintDuplex4Up
    Application.ActivePrinter = "zzzz North4upDuplex on Ne09:"
    ActiveWindow.SelectedSheets.PrintOut
end sub

Unfortunately, if I created a NEW document, and macros printout defaulted to 1up simplex.

I will have to play with PuppyDogBuddy's approach this weekend and see what happens.

It appears that Excel remembers settings at the Workbook Level (and maybe if the worksheet level) so that simply specifying the printer is not enough.

rberke

turns out Puppydogbuddy's link has an access 97 MDE file which cannot be easily converted to access 2003.

So, I am out of luck again.

rberke

I even tried the sendkeys trick.  Turns out it doesn't work in windows 7 64 bit.  The dialog gets opened, but it refuses to advance to the proper boxes and change the settings.  I even tried running excel from an administrator command prompt.

I am going to give up, once again I have killed two hours trying to do something that should be easy. As usual, I failed.

Sub test2()
 Application.ActivePrinter = "zzzz North1UpDuplex on Ne13:"
' Application.Dialogs(xlDialogPrint).Show    <  I tried this and it didn't help either
SendKeys "%fp%r{TAB}{TAB}{+}"

Exit Sub

Rob,
I don't understand your comment;
<<turns out Puppydogbuddy's link has an access 97 MDE file which cannot be easily converted to access 2003.>>

The link page has Access 2K and Access 2K2 in addition to Access 97...see below.  Further, to my best recollection, the link is to MDB files (as is Lebans general practice) so that users have access to the source code.




Below is excerpt from link page;

New October 14, 2001 A2K2 Version of ReportUtilities complete with A2K2 PrintLines Class! A2K2ReportUtilities.zip

New April 1, 2001 A2K Version of ReportUtilities complete with A2K PrintLines Class! A2KReportUtilities.zip

Ooops, I had followed your link, which led to page that had several links.  I used accidentally used the one that said "NEW RELEASE!".  Turns out it was the new release of the Access 97 version.  A different link led to the access 2002 version which seems to work fine.

The code is configured for MS Access, but I think I will be able to convert it to Excel without too much trouble. I will let you know as soon as I get a chance to play with it.

A lot of the logic is in A2K2ReportSpecs.mde which is unviewable.

In access, I can set a reference to the mde so everthing works.

But, I cannot set a reference to an MDE in Excel or Word.  

I believe the source fro the mde was originally available from http://ourworld.compuserve.com/homepages/attac-cg/acgsoft.htm 

But that link has been shutdown and Stephen Lebans has stopped doing Access.

I am thinking of deleting this question, it is taking a lot of my time which is exactly what I wanted to avoid.

I have rediscovered the source of my problem with the code I tried a year ago.

My code from last year was changing the Windows printer properties, but had no affect on the Excel printer properties.

In excel, sheet1 can be 2up duplex while sheet2 is 4up simplex (the settings are retained in the .xls file).  In contrast, if I change any MS Word document to be 4up duplex, it appears that all word documents will print with 4up duplex (I think the settings are kept in the Windows printer object as shown in Devices and Printers).

So a windows API solution cannot exist for Excel,  I will have to search for an Excel specific solution.

If I can ever download the source, the Lebans solution might work for MS Word, but it will almost certainly not work for Excel.

With this new knowledge, I believe akoster's solution WILL work for Word which would be a big plus because it is sooooooo simple.  But, I may be out of luck for Excel.

I posted before I saw your code.  That looks like the same API that I was using a year ago.  So all my comments about it not working for Excel probably still hold true.  But, I will test it anyhow when I get to the office.

Bob

Puppydogbuddy's link worked in MS Word, but not in Excel.  In both cases it correctly set the windows printer properties, but Excel does not use those properties.

Another problem is that the code always resets the printer to 1up.  The normal DEVMODE structure does not seem to have the N-up property but here are contradictory links about that. the first says it is there, the other says it is not.


http://msdn.microsoft.com/en-us/library/windows/desktop/dd183565(v=vs.85).aspx

https://www.experts-exchange.com/Programming/System/Windows__Programming/A_2090-How-to-set-Pages-Per-Sheet-Programmatically-for-N-Up-Printing.html.

I am giving up on the devmode approach for now.  I will follow akosters approach, but not today.  I have real work to do.

And, I just noticed something that might help.  

When I change the active printer from LaserJet#1 to LaserJet#2, Excel 2003 discards all previous settings related to LaserJet#1 and starts over with the default values from LaserJet#2 Windows printer properties as seen in Devices and Printers.



I think that I can force laserjet#1 to be duplex as follow


  Application.ActivePrinter = "\\SERVER02\HP LaserJet#1 on Ne08:"
  SetPrinterToDuplex
  Application.ActivePrinter = "\\SERVER02\HP LaserJet#2 on Ne09:"  ' switch away then back to force the new parameters
  Application.ActivePrinter = "\\SERVER02\HP LaserJet#1 on Ne08:"


So, if only I could handle the 2up, 4up problem I think I would be set.   But, I positively have to do some other work now.

I've got code that seems to work and I will post it later.

But there are two things that worry me. I added 11 Dwords to the DEVMODE type, with the 11th being named dmMyNup.    This was trial and error, and if I misunderstand things, I suppose I could clobber somebody else's storage.

Also, here  is part of the structure from the MSDN link I gave earlier.  I am unfamiliar with the Union syntax. I think it means that both dmNup and dmDisplayFlags share the same dword.  In other words they are aliases.

Am I correct?
  DWORD  dmPelsHeight;
  union {
    DWORD  dmDisplayFlags;
    DWORD  dmNup;
  };
  DWORD  dmDisplayFrequency;

I have attached my code that seems to do exactly what I want.  Maybe others can benefit.

I am awarding answer to Puppydogbuddy mainly because His links were pertinent.  In reality, I did not actually use them because I had followed similar links long ago.

I am also giving points to akoster.  His idea of setting up printers for each group of settings would result in MUCH similar vba coding.  But it would also require a bunch of printers which would show up every every time I used the File > Print dialog.

 

Option Explicit

Private Type PRINTER_DEFAULTS
   pDatatype As Long
   pDevmode As Long
   DesiredAccess As Long
End Type

Private Type PRINTER_INFO_2
   pServerName As Long
   pPrinterName As Long
   pShareName As Long
   pPortName As Long
   pDriverName As Long
   pComment As Long
   pLocation As Long
   pDevmode As Long               ' Pointer to DEVMODE
   pSepFile As Long
   pPrintProcessor As Long
   pDatatype As Long
   pParameters As Long
   pSecurityDescriptor As Long    ' Pointer to SECURITY_DESCRIPTOR
   Attributes As Long
   Priority As Long
   DefaultPriority As Long
   StartTime As Long
   UntilTime As Long
   Status As Long
   cJobs As Long
   AveragePPM As Long
End Type

Private Type DEVMODE
   dmDeviceName As String * 32
   dmSpecVersion As Integer
   dmDriverVersion As Integer
   dmSize As Integer
   dmDriverExtra As Integer
   dmFields As Long
   dmOrientation As Integer
   dmPaperSize As Integer
   dmPaperLength As Integer
   dmPaperWidth As Integer
   dmScale As Integer
   dmCopies As Integer
   dmDefaultSource As Integer
   dmPrintQuality As Integer
   dmColor As Integer
   dmDuplex As Integer
   dmYResolution As Integer
   dmTTOption As Integer
   dmCollate As Integer
   dmFormName As String * 32
   dmUnusedPadding As Integer
   dmBitsPerPel As Integer
   dmPelsWidth As Long
   dmPelsHeight As Long
   dmDisplayFlags As Long
   dmDisplayFrequency As Long
   dmICMMethod As Long
   dmICMIntent As Long
   dmMediaType As Long
   dmDitherType As Long
   dmreserved1 As Long
   dmreserved2 As Long
   dmreserved3 As Long
   dmreserved4 As Long
   dmreserved5 As Long
   dmreserved6 As Long
   dmreserved7 As Long
   dmreserved8 As Long
   dmreserved9 As Long
   dmreserved10 As Long
   dmMyNUp As Long  ' trial and error

End Type

Private Const DM_ORIENTATION = &H1
Private Const DM_PAPERSIZE = &H2
Private Const DM_PAPERLENGTH = &H4
Private Const DM_PAPERWIDTH = &H8
Private Const DM_DEFAULTSOURCE = &H200
Private Const DM_PRINTQUALITY = &H400
Private Const DM_COLOR = &H800
Private Const DM_DUPLEX = &H1000
Private Const DM_MyNUp = &H2000
Private Const DM_NUp = &H4000


Private Const DM_IN_BUFFER = 8
Private Const DM_OUT_BUFFER = 2
Private Const PRINTER_ACCESS_USE = &H8
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const PRINTER_NORMAL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or _
                PRINTER_ACCESS_USE)

Private Const PRINTER_ENUM_CONNECTIONS = &H4
Private Const PRINTER_ENUM_LOCAL = &H2

Private Declare Function ClosePrinter Lib "winspool.drv" _
      (ByVal hPrinter As Long) As Long
Private Declare Function DocumentProperties Lib "winspool.drv" _
      Alias "DocumentPropertiesA" (ByVal hWnd As Long, _
      ByVal hPrinter As Long, ByVal pDeviceName As String, _
      ByVal pDevModeOutput As Long, ByVal pDevModeInput As Long, _
      ByVal fMode As Long) As Long
Private Declare Function GetPrinter Lib "winspool.drv" Alias _
      "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
      pPrinter As Byte, ByVal cbBuf As Long, pcbNeeded As Long) As Long
Private Declare Function OpenPrinter Lib "winspool.drv" Alias _
      "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
      pDefault As PRINTER_DEFAULTS) As Long
Private Declare Function SetPrinter Lib "winspool.drv" Alias _
      "SetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, _
      pPrinter As Byte, ByVal Command As Long) As Long
Private Declare Function EnumPrinters Lib "winspool.drv" _
      Alias "EnumPrintersA" _
      (ByVal flags As Long, ByVal name As String, ByVal Level As Long, _
      pPrinterEnum As Long, ByVal cdBuf As Long, pcbNeeded As Long, _
      pcReturned As Long) As Long

Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyA" _
      (ByVal RetVal As String, ByVal Ptr As Long) As Long

Private Declare Function StrLen Lib "kernel32" Alias "lstrlenA" _
      (ByVal Ptr As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
      (pDest As Any, pSource As Any, ByVal cbLength As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Private Declare Function DeviceCapabilities Lib "winspool.drv" _
      Alias "DeviceCapabilitiesA" (ByVal lpDeviceName As String, _
      ByVal lpPort As String, ByVal iIndex As Long, lpOutput As Any, _
      ByVal dev As Long) As Long

Public Sub SetColorMode(iColorMode As Long)
   SetPrinterProperty DM_COLOR, iColorMode
End Sub

Public Function GetColorMode() As Long
  GetColorMode = GetPrinterProperty(DM_COLOR)
End Function

Public Sub SetDuplex(iDuplex As Long)  ' (1,2,3) means (none,flip on long edge,flip on short edge)
   SetPrinterProperty DM_DUPLEX, iDuplex
End Sub

Public Sub SetMyNUp(iMyNUp As Long) ' (0,1,2,3,4,5) means (1up,2up,4up,6up,9up,16up)
   SetPrinterProperty DM_MyNUp, iMyNUp
End Sub

Public Function GetDuplex() As Long
   GetDuplex = GetPrinterProperty(DM_DUPLEX)
End Function
Public Function GetNup() As Long
   GetNup = GetPrinterProperty(DM_NUp)
End Function
Public Function GetMyNup() As Long
   GetMyNup = GetPrinterProperty(DM_MyNUp)
End Function


Public Sub SetPrintQuality(iQuality As Long)
   SetPrinterProperty DM_PRINTQUALITY, iQuality
End Sub

Public Function GetPrintQuality() As Long
   GetPrintQuality = GetPrinterProperty(DM_PRINTQUALITY)
End Function

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 ")))
      
    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))
    Call ShowDevMode(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
    Case DM_MyNUp
       ' if the printer does not support duplex, do not try to set the property
        If dm.dmDisplayFlags = 1 Then dm.dmMyNUp = iPropertyValue
    Case Else
        Error 0
    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
' xxxxxxxxxxxxx
Private Function GetPrinterProperty(ByVal iPropertyType As Long) As Long

  'Code adapted from Microsoft KB article Q230743
  ' I got the link from http://www.tek-tips.com/viewthread.cfm?qid=599797
  ' or maybe http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_20768091.html
  ' but the originator is unknown.

  Dim hPrinter As Long
  Dim PD As PRINTER_DEFAULTS
  Dim dm As DEVMODE
  Dim sPrinterName As String

  Dim yDevModeData() As Byte
  Dim iRet As Long
      
  On Error GoTo cleanup
      
  'Get the name of the current printer
  sPrinterName = Trim$(Left$(ActivePrinter, _
        InStr(ActivePrinter, " on ")))
      
  PD.DesiredAccess = PRINTER_NORMAL_ACCESS
      
  'Get the printer handle
  iRet = OpenPrinter(sPrinterName, hPrinter, PD)
  If (iRet = 0) Or (hPrinter = 0) Then
     'Couldn't access the printer
      Exit Function
  End If

  'Find out how many bytes needed for the printer properties
  iRet = DocumentProperties(0, hPrinter, sPrinterName, 0, 0, 0)
  If (iRet < 0) Then
     'Couldn't access printer properties
      GoTo cleanup
  End If

  'Make sure the byte array is large enough, including the
  '100 bytes extra in case the printer driver is lying.
  ReDim yDevModeData(0 To iRet + 100) As Byte
      
  'Load the printer properties into the byte array
  iRet = DocumentProperties(0, hPrinter, sPrinterName, _
              VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
  If (iRet < 0) Then
     'Couldn't access printer properties
     GoTo cleanup
  End If



  'Copy the byte array to the DEVMODE structure
  Call CopyMemory(dm, yDevModeData(0), Len(dm))

  If Not dm.dmFields And iPropertyType = 0 Then
     'Requested property not available on this printer.
     GoTo cleanup
  End If

  'Get the value of the requested property
  Select Case iPropertyType
  Case DM_ORIENTATION
     GetPrinterProperty = dm.dmOrientation
  Case DM_PAPERSIZE
     GetPrinterProperty = dm.dmPaperSize
  Case DM_PAPERLENGTH
     GetPrinterProperty = dm.dmPaperLength
  Case DM_PAPERWIDTH
     GetPrinterProperty = dm.dmPaperWidth
  Case DM_DEFAULTSOURCE
     GetPrinterProperty = dm.dmDefaultSource
  Case DM_PRINTQUALITY
     GetPrinterProperty = dm.dmPrintQuality
  Case DM_COLOR
     GetPrinterProperty = dm.dmColor
  Case DM_DUPLEX
     GetPrinterProperty = dm.dmDuplex
  Case DM_MyNUp
    GetPrinterProperty = dm.dmMyNUp
  Case DM_NUp
    GetPrinterProperty = dm.dmDisplayFlags
  Case Else
    Stop: Error 0
  End Select
      
cleanup:
   'Release the printer handle
   If (hPrinter <> 0) Then Call ClosePrinter(hPrinter)

End Function

Public Sub ShowDevMode(dm As DEVMODE)
Dim MSG As String
With dm
        MSG = "-----------------------" & vbCrLf
       MSG = MSG & "dmDeviceName: " & Left(.dmDeviceName, 10) & vbCrLf
       MSG = MSG & "dmSpecVersion: " & .dmSpecVersion & vbCrLf
       MSG = MSG & "dmDriverVersion: " & .dmDriverVersion & vbCrLf
       MSG = MSG & "dmSize: " & .dmSize & vbCrLf
       MSG = MSG & "dmDriverExtra: " & .dmDriverExtra & vbCrLf
       MSG = MSG & "dmFields: " & Hex(.dmFields) & vbCrLf
       MSG = MSG & "dmOrientation: " & .dmOrientation & vbCrLf
       MSG = MSG & "dmPaperSize: " & .dmPaperSize & vbCrLf
       MSG = MSG & "dmPaperLength: " & .dmPaperLength & vbCrLf
       MSG = MSG & "dmPaperWidth: " & .dmPaperWidth & vbCrLf
       MSG = MSG & "dmScale: " & .dmScale & vbCrLf
       MSG = MSG & "dmCopies: " & .dmCopies & vbCrLf
       MSG = MSG & "dmDefaultSource: " & .dmDefaultSource & vbCrLf
       MSG = MSG & "dmPrintQuality: " & .dmPrintQuality & vbCrLf
       MSG = MSG & "dmColor: " & .dmColor & vbCrLf
       MSG = MSG & "dmDuplex: " & .dmDuplex & vbCrLf
       MSG = MSG & "dmYResolution: " & .dmYResolution & vbCrLf
       MSG = MSG & "dmTTOption: " & .dmTTOption & vbCrLf
       MSG = MSG & "dmCollate: " & .dmCollate & vbCrLf
       MSG = MSG & "dmFormName: " & Left(.dmFormName, 10) & vbCrLf
       MSG = MSG & "dmUnusedPadding: " & .dmUnusedPadding & vbCrLf
       MSG = MSG & "dmBitsPerPel: " & .dmBitsPerPel & vbCrLf
       MSG = MSG & "dmPelsWidth: " & .dmPelsWidth & vbCrLf
       MSG = MSG & "dmPelsHeight: " & .dmPelsHeight & vbCrLf
       MSG = MSG & "dmDisplayFlags: " & .dmDisplayFlags & vbCrLf
       MSG = MSG & "dmDisplayFrequency: " & .dmDisplayFrequency & vbCrLf
            MSG = MSG & "dmICMMethod: " & .dmICMMethod & vbCrLf
            MSG = MSG & "dmICMIntent: " & .dmICMIntent & vbCrLf
            MSG = MSG & "dmMediaType: " & .dmMediaType & vbCrLf
            MSG = MSG & "dmDitherType: " & .dmDitherType & vbCrLf
            MSG = MSG & "dmReserved1: " & .dmreserved1 & vbCrLf
            MSG = MSG & "dmReserved2: " & .dmreserved2 & vbCrLf
        MSG = MSG & "dmreserved1: " & .dmreserved1 & vbCrLf
        MSG = MSG & "dmreserved2: " & .dmreserved2 & vbCrLf
        MSG = MSG & "dmreserved3: " & .dmreserved3 & vbCrLf
        MSG = MSG & "dmreserved4: " & .dmreserved4 & vbCrLf
        MSG = MSG & "dmreserved5: " & .dmreserved5 & vbCrLf
        MSG = MSG & "dmreserved6: " & .dmreserved6 & vbCrLf
        MSG = MSG & "dmreserved7: " & .dmreserved7 & vbCrLf
        MSG = MSG & "dmreserved8: " & .dmreserved8 & vbCrLf
        MSG = MSG & "dmreserved9: " & .dmreserved9 & vbCrLf
        MSG = MSG & "dmreserved10: " & .dmreserved10 & vbCrLf
        
        MSG = MSG & "dmMyNUp: " & .dmMyNUp & vbCrLf
        
      ' MSG = MSG & .dmPrivateBytes()
End With

Debug.Print MSG
' MsgBox MSG
End Sub

Sub ChooseDuplexPrinterNup(pPrinter As String, pDuplex As String, pNup As Long)
Dim printer As String, duplex As Long, myNup As Long

Dim iNup As Long, iDuplex As Long, iMyNUp As Long

Select Case pPrinter
    Case "Minolta": printer = "KONICA MINOLTA Di2510f PCL5e on Ne04:"
    Case "North": printer = "\\SERVER02\HP LaserJet 5Si (North) on Ne08:"
    Case "Attic": printer = "ATTIC HP LaserJet 5000 Series PCL6 on Ne07:"
    Case Else: Error 0
End Select


Application.ActivePrinter = printer
iNup = GetNup
iDuplex = GetDuplex     'get the current settings
iMyNUp = GetMyNup


Select Case pDuplex
Case "Long"
    If iNup <> 1 Then ' if pPrinter doesn't support pDuplex, ignore request to choose it
        duplex = 1
    Else
        duplex = 2
    End If
Case "Short":
    If iNup <> 1 Then ' if pPrinter doesn't support pDuplex, ignore request to choose it
        duplex = 1
    Else
        duplex = 3
    End If
Case "None": duplex = 1
Case Else: Error 0
End Select

Select Case pNup
    Case 1: myNup = 0
    Case 2: myNup = 1
    Case 4: myNup = 2
    Case 6: myNup = 3
    Case 9: myNup = 4
    Case 16: myNup = 5
    Case Else: Error 0
End Select

    
    SetDuplex duplex             ' (1,2,3) means (none,flip on long edge,flip on short edge)
    SetMyNUp myNup              ' (0,1,2,3,4,5) means (1up,2up,4up,6up,9up,16up)

    
    Application.ActivePrinter = "Fax on Ne05:" ' choosing a different pPrinter, then switching back to original
    Application.ActivePrinter = printer    ' forces excel to refresh its own internal pPrinter properties from modified Windows pPrinter

    Dim aw As Object
    Set aw = ActiveWindow
    Select Case Application.name
        Case "Microsoft Excel": aw.SelectedSheets.PrintOut
        Case "Microsoft Word": ActiveWindow.PrintOut
        Case Else: Error 0
    End Select
    Set aw = Nothing
    
    
End Sub


Sub PrintNorth4UpDuplex()
Call ChooseDuplexPrinterNup("North", "Long", 4)
End Sub
Sub PrintNorth2UpDuplex()
Call ChooseDuplexPrinterNup("North", "Long", 2)
End Sub
Sub PrintNorth1UpDuplex()
Call ChooseDuplexPrinterNup("North", "Long", 1)
End Sub
Sub PrintNorth4UpSimplex()
Call ChooseDuplexPrinterNup("North", "None", 4)
End Sub
Sub PrintNorth2UpSimplex()
Call ChooseDuplexPrinterNup("North", "None", 2)
End Sub
Sub PrintNorth1UpSimplex()
Call ChooseDuplexPrinterNup("North", "None", 1)
End Sub

Sub PrintAnywhere(param As String)
 ' short hand    N4  means North 4up Simples
 '               n4d means north 4up duplex

 
 Dim printer As String, duplex As String, myNup As Long
 Select Case LCase(Left(param, 1))
    Case "n": printer = "North"
    Case "s": printer = "South"
    Case "k": printer = "Minolta"
    Case Else: Stop: Error 0
 End Select
 
 If Len(param) > 2 Then
    If Mid(param, 3) <> "d" Then Stop: Error 0
    duplex = "Long"
Else
    duplex = "None"
End If
   
 If InStr("12469", Mid(param & "xx", 2, 1)) < 1 Then GoTo exiterror
 myNup = val(Mid(param, 2, 1))
 
 Call ChooseDuplexPrinterNup(printer, duplex, myNup)
 Exit Sub
exiterror:
    MsgBox "your parameter must be like n4 = North 4up simplex  or n4d for duplex" _
    & vbCrLf & "syntax: [n|s|k] [1|2|4|9] [d]"
End Sub

Sub test1127()
Call PrintAnywhere("n4")
End Sub

Select allOpen in new window

Thanks Rob.  Glad you got everything resolved.

HiRob,

I have been looking at your solution and think it might resolve a similar problem I'm having.

I have created a number of simple to use print macros for law firms which switch between single side prints and double side prints by using two printer queres (PrinterA and PrinterA_Duplex with NO managed printer rights for the users and Word 2003 and Word 2007). I had tried using some VBA code to change the printer settings but this would not work as the users had No printer rights so this is why we used the two printer queues. This has been working well for years but I am now in the process of upgrading their templates and macros to Office 2010.

In Word 2010 the new Print screen allows users to change from 'Print One SIded' and "Print on Both Sides" although they still have NO managed printer rights. This means that I cannot reply on changng between the two printer queues as the settings might have been changed by the user and swtiching between printers does not reset the local Word printer setting to the default printer settings (However closing Word and then reloading will reset all the printers back to their default settings)

Can you confirm if the code you have posted works on printers with NO managed printer rights or if you have to have Managed printer rightrs to the printer for it to work.

Thanks for your help - Nikki