9 Replies Latest reply on Jul 20, 2016 5:02 PM by Elmar Klammer

    Macro sub that allows users to select a printer

    Matt Sobotka

      I currently have a macro that allows a user to paste a directory/filepath into a user form, then populates a listbox with drawings only, then allows the user to select some or all drawings within that filepath, and prints. (only it prints to the last place each individual drawing was printed to instead of allowing the user to select the desired printer)

       

      For example if user A prints a document to printer A, when user B prints the same document using the macro it automatically prints to printer A. I do not know how to let the user pick a printer within the macro.

       

      I want to add a function that allows the user to select a printer while selecting which drawings he/she wishes to print.

        • Re: Macro sub that allows users to select a printer
          Michael Spens

          Hi Matt,

          The print methods from SOLIDWORKS, like PrintOut4, include an argument for the printer (by name).  To get the locally available printers, use the sample code from this post if you're using .NET. 

          VB Helper: HowTo: List installed printers in VB .NET

          If you're using VBA, use the following.

          Retrieve a List of Installed Printers

          Hope that helps.

           

          Mike

          • Re: Macro sub that allows users to select a printer
            Elmar Klammer

            Below code will generate list of available printers and print to current default. Modify to suit.

             

            Sub GETPRINTER()
            Dim swDocExt                As SldWorks.ModelDocExtension
            Dim tempStr As String
            Dim iii As Long
            Dim PRINTER As String
            Dim nPrintSheets(1)         As Long
            Dim vPrintSheets            As Variant
            Dim DefPrinter              As String
            Dim i                       As Long

            Set swApp = CreateObject("SldWorks.Application")
            Set ModelDoc2 = swApp.ActiveDoc
            Set swDocExt = ModelDoc2.Extension
            If ModelDoc2 Is Nothing Then

            MsgBox "No drawing open.", vbExclamation, "PrintSWDrawing"
            End

            Else

                If ModelDoc2.GetType = 3 Then
               
                    Set swDraw = ModelDoc2
                    Set swSheet = swDraw.GetCurrentSheet
                    Set ps = ModelDoc2.PageSetup

             

            tempStr = GetAllPrinters(0)

            SWPrinter = GetAllPrinters(1)

            Do
                    iii = InStr(tempStr, vbCrLf)
                    Debug.Print Left(tempStr, iii - 1)
                    tempStr = Right(tempStr, Len(tempStr) - iii - 1)
            Loop Until tempStr = ""

                   

                For i = 0 To swDraw.GetSheetCount - 1

             

                    ' Print out one sheet at a time

                

                    swDocExt.PrintOut2 i + 1, 1, False, SWPrinter, ""
                   
                Debug.Print i
               
                Stop
                Next i

             

            End If
            End If
            End Sub

             

             

            Option Explicit
            #If Win64 Then
            Private Declare PtrSafe 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
            #Else
            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
            #End If

            '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

            Public Function GetAllPrinters(Flag As Long) As String
            Dim r As Long, AllPrn As String, CurrPrn As String, Buffer As String
            ' ÷èòàåì ïðèíòåðû WIN.INI
            Buffer = Space$(1024)
            If Flag = 0 Then ' âñå ïðèíòåðû
            r = GetProfileString("PrinterPorts", vbNullString, "", Buffer, Len(Buffer))
            GetAllPrinters = Replace(Left(Buffer, InStr(Buffer, Space$(2)) - 2), Chr(0), vbCrLf)
            Else ' ïðèíòåð ïî óìîë÷àíèþ
            r = GetProfileString("Windows", "Device", "", Buffer, Len(Buffer))
            GetAllPrinters = Left(Buffer, InStr(Buffer, ",") - 1)

            End If
            End Function