Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 05-24-2017, 03:50 AM
Piotrwilczak Piotrwilczak is offline Print Macro Windows 7 64bit Print Macro Office 2016
Novice
Print Macro
 
Join Date: May 2017
Posts: 1
Piotrwilczak is on a distinguished road
Default 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
Reply With Quote
  #2  
Old 05-24-2017, 04:39 AM
gmayor's Avatar
gmayor gmayor is offline Print Macro Windows 10 Print Macro Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,101
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

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
Then modify your code (which should preferably be in a different module) to establish if the printers exist using the constant parts of the names e.g. as follows. Provided those parts of the name remain constant and different from one another, the process should add the missing parts

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
Reply With Quote
Reply

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 Print Macro w/ Page Range? stickyit Outlook 1 10-06-2011 09:51 AM
Print Macro Creating macro to convert/print to pdf shabbaranks Word 3 05-18-2011 08:59 AM
Print Macro 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

Other Forums: Access Forums

All times are GMT -7. The time now is 02:59 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft