#1
|
|||
|
|||
Print Macro
Hello
We are using the macro below to print a copy on Plain and Letterhead at the same time . The application which we use is on remote server and our print server is on local network ( I think we use something called Remote Desktop Easy Print which kind of redirects the print job from the server on which the application reside to print server in our office). For the macro to work we have to edit it and change the redirected values every day. Is there a way to edit this macro to specify the range of numbers (lets say from 1 to 65,000) no matter to which number printing is redirected macro would still work? Sub Macro1() ' ' Macro1 Macro ' ' ActivePrinter = _ "TCL012 - Team A - Headed on abctclfls001 (redirected 613)" Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _ wdPrintDocumentWithMarkup, Copies:=1, Pages:="", PageType:= _ wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _ PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _ PrintZoomPaperHeight:=0 ActivePrinter = "TCL012-Team A on abctclfls001 (redirected 613)" Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _ wdPrintDocumentWithMarkup, Copies:=1, Pages:="", PageType:= _ wdPrintAllPages, Collate:=True, Background:=True, PrintToFile:=False, _ PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _ PrintZoomPaperHeight:=0 End Sub I would be grateful if you could assist . Thank You Piotr |
#2
|
||||
|
||||
In theory at least it should be possible using a function by Chip Pearson to get the list of available printers. Obviously I cannot test this without access to your system, but I have high expectations that it should work - if the manually changed version works.
Add the following to a new module: Code:
Option Explicit Public oVar As Variable Public bVar As Boolean ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' modListPrinters ' By Chip Pearson, chip@cpearson.com www.cpearson.com ' Created 22-Sept-2012 ' This provides a function named GetPrinterFullNames that ' returns a String array, each element of which is the name ' of a printer installed on the machine. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Const HKEY_CURRENT_USER As Long = &H80000001 Private Const HKCU = HKEY_CURRENT_USER Private Const KEY_QUERY_VALUE = &H1& Private Const ERROR_NO_MORE_ITEMS = 259& Private Const ERROR_MORE_DATA = 234 #If Win64 Then Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32" _ Alias "RegOpenKeyExA" ( _ ByVal HKey As Long, _ ByVal lpSubKey As String, _ ByVal ulOptions As Long, _ ByVal samDesired As Long, _ phkResult As Long) As Long Private Declare PtrSafe Function RegEnumValue Lib "advapi32.dll" _ Alias "RegEnumValueA" ( _ ByVal HKey As Long, _ ByVal dwIndex As Long, _ ByVal lpValueName As String, _ lpcbValueName As Long, _ ByVal lpReserved As Long, _ lpType As Long, _ lpData As Byte, _ lpcbData As Long) As Long Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" ( _ ByVal HKey As Long) As Long #Else Private Declare Function RegOpenKeyEx Lib "advapi32" _ Alias "RegOpenKeyExA" ( _ ByVal HKey As Long, _ ByVal lpSubKey As String, _ ByVal ulOptions As Long, _ ByVal samDesired As Long, _ phkResult As Long) As Long Private Declare Function RegEnumValue Lib "advapi32.dll" _ Alias "RegEnumValueA" ( _ ByVal HKey As Long, _ ByVal dwIndex As Long, _ ByVal lpValueName As String, _ lpcbValueName As Long, _ ByVal lpReserved As Long, _ lpType As Long, _ lpData As Byte, _ lpcbData As Long) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" ( _ ByVal HKey As Long) As Long #End If Public Function GetPrinterFullNames() As String() ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' GetPrinterFullNames ' By Chip Pearson, chip@cpearson.com, www.cpearson.com ' Returns an array of printer names, where each printer name ' is the device name followed by the port name. The value can ' be used to assign a printer to the ActivePrinter property of ' the Application object. Note that setting the ActivePrinter ' changes the default printer for Excel but does not change ' the Windows default printer. ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim Printers() As String ' array of names to be returned Dim PNdx As Long ' index into Printers() Dim HKey As Long ' registry key handle Dim res As Long ' result of API calls Dim Ndx As Long ' index for RegEnumValue Dim ValueName As String ' name of each value in the printer key Dim ValueNameLen As Long ' length of ValueName Dim DataType As Long ' registry value data type Dim ValueValue() As Byte ' byte array of registry value value Dim ValueValueS As String ' ValueValue converted to String Dim CommaPos As Long ' position of comma character in ValueValue Dim ColonPos As Long ' position of colon character in ValueValue Dim m As Long ' string index ' registry key in HCKU listing printers Const PRINTER_KEY = "Software\Microsoft\Windows NT\CurrentVersion\Devices" PNdx = 0 Ndx = 0 ' assume printer name is less than 256 characters ValueName = String$(256, Chr(0)) ValueNameLen = 255 ' assume the port name is less than 1000 characters ReDim ValueValue(0 To 999) ' assume there are less than 1000 printers installed ReDim Printers(1 To 1000) ' open the key whose values enumerate installed printers res = RegOpenKeyEx(HKCU, PRINTER_KEY, 0&, _ KEY_QUERY_VALUE, HKey) ' start enumeration loop of printers res = RegEnumValue(HKey, Ndx, ValueName, _ ValueNameLen, 0&, DataType, ValueValue(0), 1000) ' loop until all values have been enumerated Do Until res = ERROR_NO_MORE_ITEMS m = InStr(1, ValueName, Chr(0)) If m > 1 Then ' clean up the ValueName ValueName = Left(ValueName, m - 1) End If ' find position of a comma and colon in the port name CommaPos = InStr(1, ValueValue, ",") ColonPos = InStr(1, ValueValue, ":") ' ValueValue byte array to ValueValueS string On Error Resume Next ValueValueS = Mid(ValueValue, CommaPos + 1, ColonPos - CommaPos) On Error GoTo 0 ' next slot in Printers PNdx = PNdx + 1 Printers(PNdx) = ValueName ' & " on " & ValueValueS ' reset some variables ValueName = String(255, Chr(0)) ValueNameLen = 255 ReDim ValueValue(0 To 999) ValueValueS = vbNullString ' tell RegEnumValue to get the next registry value Ndx = Ndx + 1 ' get the next printer res = RegEnumValue(HKey, Ndx, ValueName, ValueNameLen, _ 0&, DataType, ValueValue(0), 1000) ' test for error If (res <> 0) And (res <> ERROR_MORE_DATA) Then Exit Do End If Loop ' shrink Printers down to used size ReDim Preserve Printers(1 To PNdx) res = RegCloseKey(HKey) ' Return the result array GetPrinterFullNames = Printers End Function Public Function IsBounded(vArray As Variant) As Boolean 'If the variant passed to this function is an array, the function will return True; 'otherwise it will return False On Error Resume Next IsBounded = IsNumeric(UBound(vArray)) End Function Code:
Option Explicit Sub PrintToNamedPrinters() Dim x As Integer Dim strPrinters As Variant Const sPrinterA As String = "TCL012 - Team A - Headed on abctclfls001" Const sPrinterB As String = "TCL012-Team A on abctclfls001" strPrinters = GetPrinterFullNames If IsBounded(strPrinters) Then For x = LBound(strPrinters) To UBound(strPrinters) If strPrinters(x) Like sPrinterA & "*" Then ActivePrinter = strPrinters(x) Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _ wdPrintDocumentWithMarkup, copies:=1, Pages:="", PageType:= _ wdPrintAllPages, collate:=True, Background:=True, PrintToFile:=False, _ PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _ PrintZoomPaperHeight:=0 Exit For End If Next x End If If IsBounded(strPrinters) Then For x = LBound(strPrinters) To UBound(strPrinters) If strPrinters(x) Like sPrinterB & "*" Then ActivePrinter = strPrinters(x) Application.PrintOut FileName:="", Range:=wdPrintAllDocument, Item:= _ wdPrintDocumentWithMarkup, copies:=1, Pages:="", PageType:= _ wdPrintAllPages, collate:=True, Background:=True, PrintToFile:=False, _ PrintZoomColumn:=0, PrintZoomRow:=0, PrintZoomPaperWidth:=0, _ PrintZoomPaperHeight:=0 Exit For End If Next x End If End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
Thread Tools | |
Display Modes | |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
How can I print a different quantity of each page? A macro maybe? | unittwentyfive | Word | 2 | 04-05-2014 07:47 PM |
Print Macro w/ Page Range? | stickyit | Outlook | 1 | 10-06-2011 09:51 AM |
Creating macro to convert/print to pdf | shabbaranks | Word | 3 | 05-18-2011 08:59 AM |
Macro for Print | sivakl2001 | Word VBA | 6 | 03-24-2011 11:25 PM |
Print Macro in MS Word | steve207 | Word VBA | 0 | 09-10-2010 02:11 AM |