Macro to print document in Duplex format

I  am trying to write a macro in a template (.dot) file to be used on 
2000 documents based on it. The macro has code to print duplex. The code is 
give below. I get error 'Unable to set shared printer settings' while trying 
to assign printersettings. Isnt it the same like changing the Duplex setting 
in the print->printing preferances? 
Please advice.

Option Explicit


       pDatatype As Long
       pDevmode As Long
       DesiredAccess As Long
   End Type

   Public 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

   Public 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
   End Type

   Public Const DM_DUPLEX = &H1000&
   Public Const DM_IN_BUFFER = 8

   Public Const DM_OUT_BUFFER = 2
   Public Const PRINTER_ACCESS_USE = &H8

   Public Declare Function ClosePrinter Lib "winspool.drv" _
    (ByVal hPrinter As Long) As Long
   Public 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
   Public 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
   Public Declare Function OpenPrinter Lib "winspool.drv" Alias _
     "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, _
     pDefault As PRINTER_DEFAULTS) As Long
   Public 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

   Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (pDest As Any, pSource As Any, ByVal cbLength As Long)

   ' ==================================================================
   ' SetPrinterDuplex
   '  Programmatically set the Duplex flag for the specified printer
   '  driver's default properties.
   '  Returns: True on success, False on error. (An error will also

   '  display a message box. This is done for informational value
   '  only. You should modify the code to support better error
   '  handling in your production application.)
   '  Parameters:
   '    sPrinterName - The name of the printer to be used.
   '    nDuplexSetting - One of the following standard settings:
   '       1 = None
   '       2 = Duplex on long edge (book)
   '       3 = Duplex on short edge (legal)
   ' ==================================================================
Public Function SetPrinterDuplex(ByVal s2ndFloorBinder As String, ByVal 
nDuplexSetting As Long) As Boolean

      Dim hPrinter As Long
      Dim pinfo As PRINTER_INFO_2
      Dim dm As DEVMODE
      Dim yDevModeData() As Byte
      Dim yPInfoMemory() As Byte
      Dim nBytesNeeded As Long
      Dim nRet As Long, nJunk As Long
      On Error GoTo cleanup
      If (nDuplexSetting < 1) Or (nDuplexSetting > 3) Then
         MsgBox "Error: dwDuplexSetting is incorrect."
         Exit Function
      End If
      pd.DesiredAccess = PRINTER_ACCESS_USE
      nRet = OpenPrinter(s2ndFloorBinder, hPrinter, pd)
      If (nRet = 0) Or (hPrinter = 0) Then
         If Err.LastDllError = 5 Then
            MsgBox "Access denied -- See the article for more info."
            MsgBox "Cannot open the printer specified " & _
              "(make sure the printer name is correct)."
         End If
         Exit Function
      End If
      nRet = DocumentProperties(0, hPrinter, s2ndFloorBinder, 0, 0, 0)
      If (nRet < 0) Then
         MsgBox "Cannot get the size of the DEVMODE structure."
         GoTo cleanup
      End If
      ReDim yDevModeData(nRet + 100) As Byte
      nRet = DocumentProperties(0, hPrinter, s2ndFloorBinder, _
                  VarPtr(yDevModeData(0)), 0, DM_OUT_BUFFER)
      If (nRet < 0) Then
         MsgBox "Cannot get the DEVMODE structure."
         GoTo cleanup
      End If
      Call CopyMemory(dm, yDevModeData(0), Len(dm))
      If Not CBool(dm.dmFields And DM_DUPLEX) Then
        MsgBox "You cannot modify the duplex flag for this printer " & _
               "because it does not support duplex or the driver " & _
               "does not support setting it from the Windows API."
         GoTo cleanup
      End If
      dm.dmDuplex = nDuplexSetting
      Call CopyMemory(yDevModeData(0), dm, Len(dm))
      nRet = DocumentProperties(0, hPrinter, s2ndFloorBinder, _
        VarPtr(yDevModeData(0)), VarPtr(yDevModeData(0)), _

      If (nRet < 0) Then
        MsgBox "Unable to set duplex setting to this printer."
        GoTo cleanup
      End If
      Call GetPrinter(hPrinter, 2, 0, 0, nBytesNeeded)
      If (nBytesNeeded = 0) Then GoTo cleanup
      ReDim yPInfoMemory(nBytesNeeded + 100) As Byte

      nRet = GetPrinter(hPrinter, 2, yPInfoMemory(0), nBytesNeeded, nJunk)
      If (nRet = 0) Then
         MsgBox "Unable to get shared printer settings."
         GoTo cleanup
      End If
      Call CopyMemory(pinfo, yPInfoMemory(0), Len(pinfo))
      pinfo.pDevmode = VarPtr(yDevModeData(0))
      pinfo.pSecurityDescriptor = 0
      Call CopyMemory(yPInfoMemory(0), pinfo, Len(pinfo))
      nRet = SetPrinter(hPrinter, 2, yPInfoMemory(0), 0)
      If (nRet = 0) Then
         MsgBox "Unable to set shared printer settings."
      End If
      SetPrinterDuplex = CBool(nRet)

      If (hPrinter <> 0) Then Call ClosePrinter(hPrinter)

   End Function

Sub Duplexprinting()

    Dim sPrinterName  As String
    sPrinterName = Trim$(Left$(ActivePrinter, InStr(ActivePrinter, " on ")))
    If SetPrinterDuplex(sPrinterName, 2) Then
        If MsgBox("Shall I Print?", vbYesNo) = vbYes Then
        Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _
            wdPrintDocumentContent, Copies:=1, Pages:="", 
PageType:=wdPrintAllPages, _
            Collate:=True, Background:=True, PrintToFile:=False, 
PrintZoomColumn:=0, _
            PrintZoomRow:=0, PrintZoomPaperWidth:=0, PrintZoomPaperHeight:=0
        End If
        SetPrinterDuplex sPrinterName, 1
    End If
End Sub


1/22/2010 1:37:02 AM
word.vba.general 1023 articles. 1 followers. Follow

0 Replies

Similar Articles

[PageSpeed] 5


Similar Artilces:

Macro warning with no macros
I have a workbook that when I try to open it I get the warning tellin me it contains macros and asking whether I want to Enable or Disabl them. I put no macros, no VB scripts, nothing at all in the workboo other than standard Excel formulas and some charts. I developed it i Excel 2002, SP-2, but have moved it back and forth between tw computers, the other which has Excel 97. Regardless of whether Enable or Disable or change the security settings so as not to get th warning, once the workbook is open even if I go t Tools-Macro-Macros... it lists no macros. How can I find out what's cau...

Word Quits when I close document window
I'm running Office:mac X on OS 10.1.5. When I close a window in word, it usually quits with an error message that says it quit unexpectedly and that other applications and the system are not affected. This also happened when I was running Word for Mac '98 on Classic 9.2.2, but not as consistently. Does anyone know what is going on and how to fix it? In article <0aef01c3789d$3d5f4c00$a001280a@phx.gbl>, "Liz" <> wrote: > I'm running Office:mac X on OS 10.1.5. When I close a > window in word, it usually quits with an error message th...

Can anybody tell me how to kick off a macro automatically as file is opened? Regards ...

Version: 2008 Operating System: Mac OS X 10.4 (Tiger) Processor: intel Hi, I'm thinking of buying Mac: Office 2008, but before I do I want to check that I will be able to download Scritpsmart collection of templates without any glitches: <> Does anyone know if I can do this? Regards, SP. In article <ee98ff5.-1@webcrossing.caR9absDaxw>, wrote: > Version: 2008 > Operating System: Mac OS X 10.4 (Tiger) > Processor: intel > > Hi, > > I'm thinking of buying Mac: Of...

Is there a formular or format to change 1 to one
Is there a formular or format to change a number "1" into the word "one". Hi Kevin, See: --- Regards, Norman "Kevin" <> wrote in message > Is there a formular or format to change a number "1" into the word "one". See -- HTH RP (remove nothere from the email address if mailing direct) "Kevin" <Kevin@discussions.micro...

Run macro automatically.
How do I make a macro run automatically when a worksheet it is attached to is loaded? right click on the sheet tab>view code>left window worksheet>right window activate -- Don Guillett SalesAid Software "Excel macro" <Excel> wrote in message > How do I make a macro run automatically when a worksheet it is attached to is > loaded? I am unable to find "activate " when I right click on worksheet. ( i assume that you are referring to the windo...

Terminal Server based Outlook 2007 printing hieroglyphics
We are running terminal services(Server 2008 R2) with Outlook 2007 installed (SP2). No other Office components are installed. When printing emails, (all other printing is fine), the text becomes compressed and looks like hieroglyphics. 1. I have tried removing all printer drivers and re-installing the drivers with no luck. 2. I have also applied the lastest patches and Service packs to the server and Outlook. 3. I have tried using different types of drivers with each printer ie. PS, MS, PCL5e, PCL6 etc with no luck. Any help would be appreciated as users are getting very fr...

Help with macro/and or formula?
Perhaps this is a silly question, but i just can't figure out how t format this worksheet. The problem is that a lot of the cells hav numbers in them with negative signs in the back instead of in the fron (ie. 23-) and i was wondering if anyone knew of a macro/formula i coul use to quickly fix this problem for all the cells. I would b extremely grateful. Thanks -- brefed1 ----------------------------------------------------------------------- brefed15's Profile: View this thread:

Attached Toolbars Macros
Excel 2003 I have a custom tool bar, this tool bar has several items, each item is pointing to a VBA code. This tool bar is attached to the worksheet. I've copied this spreadsheet to several computers. After I copied the spreadsheet I decided to rename the spreadsheet, after I renamed the spreadsheet the Toolbar Item's macros were still pointing to the old name, I reasigned each tool bar item to the current spreadsheet, saved the spreadsheet and everything was working on my computer, but when I re-copied the new spreadsheet to other computers and I clicked on the Toolbar Item...

Printing checks without printing EFT's
We pay vendors using mostly EFT's but still pay some via check. First we run EFT's and then run checks separately. However sometimes the check batch also includes EFT's thus we need a method to select checks only. Question is how can I select only the check vendors for payment. When paying via EFT, there is a selection for "EFT Only" but no such selection for "Checks Only". Is there a way around this issue? Doug Hi Doug I was browsing and saw this, we had a similar scenario We solved it by using payment priority within the creditor (under options) ...

Protected sheets and running macros
i have a sheet with a macro ran by a normal button at the top. Howeve when i protect the worksheet where ever i click on the sheet the macr executes. Can any one offer any advice on how to stop this? Thanks Robert -- Message posted from hi, i am not able to reproduce the problem, hence i may not be able t provide a panacea for that issue. here is what i suggest. i have a sheet that has a macro that is run when a control toolbo button (that is, not a form button) is clicked. this sheet is protected based on the user logged in. what i have don is to protect t...

Conditional Formats #2
I have to somehow apply a compound conditional format to a worksheet that is only partially shown below. Here is my requirements which are difficult to explain, The correct answers to a multiple choice test are shown in row 2, columns B,D,F,H Students were asked to gauge their confidence in their answers, on a scale from 1-3 which are shown in C,E,G,I I need to conditionally format the answers so that they are Bold Italics if the correct answer appears and color code the cells with the answers depending upon the confidence level (on color for a 1, another for 2, and a third for a 3). ...

Banding when printing Gradients in Excel 2007
I use complex spreadsheets with macros to report company sales data. The reports were created in Excel 2002. When I print the charts from 2002, they print fine... text is crisp and gradients are gradients. When I print the same charts in Excel 2007, the gradients don't print. Rather I get a series of four distinct color bands. The lines and text are also not crisp but rather jagged. We use a color "powerhouse" laser printer -- Gestener aka Ricoh (too many copies to print on an inkjet). Has anyone had this problem? Anyone know of a fix? ...

Macro Freezes Reading Pane
I have a macro that Sends/Receives Tasks from Project Server into Outlook Tasks. Everything is working fine, except one weird thing that happens. I have the Timer set on the macro and it starts as soon as Outlook starts. The macro gets the tasks from ProjectServer every hour. As soon as the macro starts running the Reading pane freezes in the Inbox. If i stop the macro then Reading pane is back to normal. Can anyone please tell me if there is something I can do in VBA to fix this annoying issue. Thanks a lot ...

Macro to remove rows?
Hi, I receive thousands of rows of data from an extract that comes from a database. The data extract automatically generates page headers that need to be removed, and I would love to automate this process. The headers do have a pattern to them, but I'm not clever enough to figure out a good way to use that to write a macro. The first row of the header starts with hyphens ------------------------------- Then there's a variable number of rows of header data to delete followed by another row of hyphens ------------------------------- Then 2 additional rows that must be deleted. The nu...

Calling on a macro within a macro!
Hey All!! Quick Question - How do you call up a macro within a current macro? I have one big macro and I need it to jump to several other macros when it runs! Does it matter where the other macros are stored or is it better to have them all in one module? Help appreciated Thnx! Hi Mellowe, '=============>> Public Sub Main() 'Your code Call One 'your code End Sub '<<============= '=============>> Public Sub One() MsgBox "Hi from One" End Sub '<<============= > Does it matter where the other macros are stored or ...

How do I get my publisher 2003 documents to print to the edge of .
How can I get documents to print to the edge of a page in Publisher 2003? I want my picture to bleed to the edge and have set all gaps to 0. Yet I still get a big white border around each side of the page as opposed to the graphics printing to the edge. Ple Is your printer capable of doing that? Not all are. -- JoAnn Paules MVP Microsoft [Publisher] "Macey" <> wrote in message > How can I get documents to print to the edge of a page in Publisher 2003? > I > want my pi...

receipt printing #5
How do I print a receipt prior to tendering? I know that you can create a Quote and then print, but what a mess. ...

Format Records alternating colours.
Hi I would like to have aternating rows differnet colours. eg. customer no 123 red 123 red 456 green 456 green 456 green 789 red 789 red Can you tell excel to do this? mike Try this: Insert a blank (helper) column before your data. (I'll assume it will be Col_A. Col_B will list customers) A2: =IF(B2=B1,A1,NOT(A1)) Copy A2 down as far as you need Select from B2 down and to the right as far as you have data ...with B2 as the active cell. From the Excel Main Menu: <format><conditional formatting> Condition_1: Formula is: =$A2 Click the [Format] button the Re...

Top margin shifts when viewed in print preview
This happened in Pub 97. Just installed Pub 2003, same thing. An 8.5 x 11 landscape page with margin guides all set at .2 inches (for Minolta 3300), also vertical and horizontal ruler guides and grid guides set at 2 columns and rows spaced at .4 inches. The same graphic is in each quadrant filling the bordered area. (Four postcards with an even border when the page is cut into quarters). Looks great until I view the print preview or print it, then it views and prints with a top margin of 6mm or about .25 inch. I don't think it's my printer properties, as I have printed it ...

How do you print the membership of a distribution group in E2k3
How do you print the membership of a distribution group in E2k3 In 5.5, there was the awkward workaround to "add (or remove) a member, then highlight all the users from their and copy them to the clipboard and paste them in a text file. Don't see "export contents" - You can but it's blank. Don't see any way to get to a copyable list. What am I missing? believe it or not, the easiest way is via Outlook... Create a new meeting the group to invite. Then "expand" the group in the attendee availability window. Then select all of the membe...

shortcut keys to macros
Hi, Is it at all possible to assign shortcut keys to macros in Outlook? Thx, Hans ...

Software to convert English document to Hindi
Is there any software available to convert an English language text document to Hindi language document by using dictionary based translation (not transliteration). For example: English text: My name converted to : ???? ??? "S N" <sn@invalid.invalid> wrote in message news:##J8WYopKHA.3912@TK2MSFTNGP06.phx.gbl... > Is there any software available to convert an English language text > document > to Hindi language document by using dictionary based translation (not > transliteration). > For example: > > English text: My name > co...

Retain Field Format From Excel
I have an excel file that I'm importing to Access. This field consists of "time"...hours, minutes, seconds. The format in excel is set to "Custom" - [h]:mm:ss. The data elements look like 150:27:50, 2:30:25, etc... The time stays the same for some records but others change. For example...150:27:50 becomes 6:27:50 AM when imported. If someone can help me figure a way to retain the format for all records I would greatly appreciate it. Thank You, Lisa W. 150 divided by 24 = 6.25 or 6 and 1/4 days which is displayed a 6 AM. You need to use a ...

Can i print copy numbers?
At my job we must print copies of databases and keep track of them. We only print 100 copies at a time. Is there a way to make it automaticly put "1 of 100" or "copy 1 of 100" in the footer?? You could run a little macro: Option Explicit Sub testme() Dim iCtr As Long For iCtr = 1 To 3 '100 when you're ready With ActiveSheet .PageSetup.RightFooter = "Copy " & iCtr & " of 100" .PrintOut preview:=True 'false when you're ready End With Next iCtr End Sub I used 1 to 3 and pri...