VBA Change Printer Question

[tmckissick]

Hi all,

I have a spreadsheet that has a summary tab with a list of customer, addresses, etc., and another tab that creates invoices from the summary. I wrote a macro that cycles through the table and creates and prints invoices to the default printer.

That part works fine.

I am trying to add some code that changes the default printer, prints the file to pdf, then restores the default printer. It does not work:

Sub PrintAll()


Dim strValidationRange As String
Dim rngValidation As Range
Dim rngDepartment As Range
Dim STDprinter As String

Application.ScreenUpdating = False

strValidationRange = Range("A10").Validation.Formula1
Set rngValidation = Range(strValidationRange)


For Each rngDepartment In rngValidation.Cells
Range("A10").Value = rngDepartment.Value
ActiveSheet.PrintOut


Next


STDprinter = Application.ActivePrinter
Application.ActivePrinter = "Microsoft Print to PDF"
ActiveSheet.PrintOut


strValidationRange = Range("A10").Validation.Formula1
Set rngValidation = Range(strValidationRange)


For Each rngDepartment In rngValidation.Cells
Range("A10").Value = rngDepartment.Value
ActiveSheet.PrintOut


Application.ActivePrinter = STDprinter

Next

Application.ScreenUpdating = True

End Sub

Any Suggestions?

 

[ranman256]

paste the code into a module then:
usage:

'get the current default printer
vPtr =GetDefaultPrinter()
'set pdf
SetDefaultPrinter "Adobe PDF"

'print here

'then reset back
SetDefaultPrinter vPtr

Private Const HWND_BROADCAST As Long = &HFFFF&
Private Const WM_WININICHANGE As Long = &H1A


' The following code allows one to read, and write to the WIN.INI files
' In win 2000 the printer settings are actually in the registry. However, windows
' handles this correctly
'
Private Declare Function GetProfileString Lib "kernel32" _
   Alias "GetProfileStringA" _
  (ByVal lpAppName As String, _
   ByVal lpKeyName As String, _
   ByVal lpDefault As String, _
   ByVal lpReturnedString As String, _
   ByVal nSize As Long) As Long


Private Declare Function WriteProfileString Lib "kernel32" _
   Alias "WriteProfileStringA" _
  (ByVal lpszSection As String, _
   ByVal lpszKeyName As String, _
   ByVal lpszString As String) As Long


Private Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal wMsg As Long, _
   ByVal wParam As Long, _
   lparam As Any) As Long




'----------------
Function SetDefaultPrinter(strPrinterName As String) As Boolean
'----------------


   Dim strDeviceLine As String
   Dim strBuffer     As String
   Dim lngbuf        As Long
    
  ' get the full device string
  '
   strBuffer = Space(1024)
   lngbuf = GetProfileString("PrinterPorts", strPrinterName, "", strBuffer, Len(strBuffer))
  
  'Write out this new printer information in
  ' WIN.INI file for DEVICE item
  If lngbuf > 0 Then
     
     strDeviceLine = strPrinterName & "," & _
                     fstrDField(strBuffer, Chr(0), 1) & "," & _
                     fstrDField(strBuffer, Chr(0), 2)
                     
     Call WriteProfileString("windows", "Device", strDeviceLine)
     SetDefaultPrinter = True
     
     ' Below is optional, and should be done. It updates the existing windows
     ' so the "default" printer icon changes. If you don't do the below..then
     ' you will often see more than one printer as the default! The reason *not*
     ' to do the SendMessage is that many open applications will now sense the change
     ' in printer. I vote to leave it in..but your case you might not want this.
     '
     
     'Call SendMessage(HWND_BROADCAST, WM_WININICHANGE, 0, ByVal "windows")
    
  Else
     SetDefaultPrinter = False
  End If
End Function


'----------------
Private Function fstrDField(mytext As String, delim As String, groupnum As Integer) As String
'----------------


   ' this is a standard delimiter routine that every developer I know has.
   ' This routine has a million uses. This routine is great for splitting up
   ' data fields, or sending multiple parms to a openargs of a form
   '
   '  Parms are
   '        mytext   - a delimited string
   '        delim    - our delimiter (usually a , or / or a space)
   '        groupnum - which of the delimited values to return
   '
   
Dim startpos As Integer, endpos As Integer
Dim groupptr As Integer, chptr As Integer


chptr = 1
startpos = 0
 For groupptr = 1 To groupnum - 1
    chptr = InStr(chptr, mytext, delim)
    If chptr = 0 Then
       fstrDField = ""
       Exit Function
    Else
       chptr = chptr + 1
    End If
 Next groupptr
startpos = chptr
endpos = InStr(startpos + 1, mytext, delim)
If endpos = 0 Then
   endpos = Len(mytext) + 1
End If


fstrDField = Mid$(mytext, startpos, endpos - startpos)


End Function




'----------------
Function GetDefaultPrinter() As String
'----------------


   Dim strDefault    As String
   Dim lngbuf        As Long


   strDefault = String(255, Chr(0))
   lngbuf = GetProfileString("Windows", "Device", "", strDefault, Len(strDefault))
   If lngbuf > 0 Then
      GetDefaultPrinter = fstrDField(strDefault, ",", 1)
   Else
      GetDefaultPrinter = ""
   End If


End Function