7 Replies Latest reply on Feb 8, 2018 4:53 PM by Hank Costner

    how to save sheets separately to pdf in vba

    Hank Costner

      I am using code that I found on this forum. I program in C++ normally. I'm learning how to work with SolidWorks VBA. I want to take a drawing file with many sheets (the amount will always be in multiples of 3) and save one sheet by itself, then the next two together. That process would be repeated until all the sheets are saved. When I run the program on a drawing file consisting of 3 sheets, it makes 2 pdf files (as expected). However, both pdf files have all 3 sheets. One pdf file should have one sheet, and the other should have two sheets.

      I'm using this line to set the sheets to be saved ==> swExportPDFData.SetSheets swExportData_ExportSpecifiedSheets, sales

      sales is an array that holds one sheet name.

      As far as I know, swExportData_ExportSpecifiedSheets tells the computer that I'm saving sheets separately.

       

      This line is in context below. The complete code is further below.

       

      line in context

      ----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

       

      vSheetNameArr = swDraw.GetSheetNames

       

      Dim numberOfSheets As Integer

      numberOfSheets = swModel.GetSheetCount

      Dim i As Integer

      i = 0

       

       

      Dim sales(0) As Variant

      Dim fab(1) As Variant

      MsgBox vSheetNameArr(0)

      Set swExportPDFData = swApp.GetExportFileData(1)

       

       

      Do While i < numberOfSheets

       

      sales(0) = vSheetNameArr(i)

      fab(0) = vSheetNameArr(i + 1)

      fab(1) = vSheetNameArr(i + 2)

       

      swExportPDFData.SetSheets swExportData_ExportSpecifiedSheets, sales

      swModel.Extension.SaveAs Path & sales(0) & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings

       

      swExportPDFData.SetSheets swExportData_ExportSpecifiedSheets, fab

      swModel.Extension.SaveAs Path & fab(0) & " & QC " & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings

       

       

      i = i + 3

      Loop

       

       

       

      complete code

      ------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

       

      ' This macro is provided as is.  No claims, support, refund, safety net, or

      ' warranties are expressed or implied.  By using this macro and/or its code in

      ' any way whatsoever, the user and any entities which the user represents,

      ' agree to hold the authors free of any and all liability.  Free distribution

      ' and use of this code in other free works is welcome.  If any portion of

      ' this code is used in other works, credit to the authors must be placed in

      ' that work within a user viewable location (e.g., macro header).  All other

      ' forms of distribution (i.e., not free, fee for delivery, etc) are prohibited

      ' without the expressed written consent by the authors.  Use at your own risk!

      ' ------------------------------------------------------------------------------

      ' Written by: Deepak Gupta (http://gupta9665.com/)

      ' -----------------------------------------------------------------------------

      ' Version 2: Added option for selecting Output folder ------------- 08/07/14

      ' Version 2.1: Added revision in file name ------------- 01/20/15

       

       

      Option Explicit

      Private Const BIF_RETURNONLYFSDIRS As Long = &H1

      Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2

      Private Const BIF_RETURNFSANCESTORS As Long = &H8

      Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000

      Private Const BIF_BROWSEFORPRINTER As Long = &H2000

      Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000

      Private Const MAX_PATH As Long = 260

      Function BrowseFolder(Optional Caption As String, _

          Optional InitialFolder As String) As String

       

       

      Dim SH As Shell32.Shell

      Dim F As Shell32.Folder

       

       

      Set SH = New Shell32.Shell

      Set F = SH.BrowseForFolder(0&, Caption, BIF_RETURNONLYFSDIRS, InitialFolder = "Desktop")

      If Not F Is Nothing Then

          BrowseFolder = F.Items.Item.Path

      End If

       

       

      End Function

      Sub main()

       

       

      Dim swApp                   As SldWorks.SldWorks

      Dim swModel                 As SldWorks.ModelDoc2

      Dim swDraw                  As SldWorks.DrawingDoc

      Dim swSheet                 As SldWorks.Sheet

      Dim vSheetNameArr           As Variant

      Dim vSheetName              As Variant

      Dim bRet                    As Boolean

      Dim swExportPDFData         As SldWorks.IExportPdfData

      Dim lErrors                 As Long

      Dim lWarnings               As Long

      Dim Path                    As String

      Dim Value                   As String

       

       

      Set swApp = Application.SldWorks

       

       

          Path = BrowseFolder("Select a Path/Folder")

          If Path = "" Then

          MsgBox "Please select the path and try again"

          End

          Else

          Path = Path & "\"

          End If

         

      Set swModel = swApp.ActiveDoc

       

       

      ' Is document active?

       

       

      If swModel Is Nothing Then

       

       

          swApp.SendMsgToUser2 "A Drawing document must be active.", swMbWarning, swMbOk

       

       

          Exit Sub

       

       

      End If

       

       

       

      ' Is it a Drawing document?

       

       

      If swModel.GetType <> swDocDRAWING Then

       

       

          swApp.SendMsgToUser2 "A Drawing document must be active.", swMbWarning, swMbOk

       

       

          Exit Sub

       

       

      End If

       

       

       

       

      Set swDraw = swModel

      Value = swDraw.CustomInfo("Revision")

       

       

      Set swSheet = swDraw.GetCurrentSheet

       

       

      vSheetNameArr = swDraw.GetSheetNames

       

      Dim numberOfSheets As Integer

      numberOfSheets = swModel.GetSheetCount

      Dim i As Integer

      i = 0

       

       

      Dim sales(0) As Variant

      Dim fab(1) As Variant

      MsgBox vSheetNameArr(0)

      Set swExportPDFData = swApp.GetExportFileData(1)

       

       

      Do While i < numberOfSheets

       

      sales(0) = vSheetNameArr(i)

      fab(0) = vSheetNameArr(i + 1)

      fab(1) = vSheetNameArr(i + 2)

       

      swExportPDFData.SetSheets swExportData_ExportSpecifiedSheets, sales

      swModel.Extension.SaveAs Path & sales(0) & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings

       

      swExportPDFData.SetSheets swExportData_ExportSpecifiedSheets, fab

      swModel.Extension.SaveAs Path & fab(0) & " & QC " & ".PDF", 0, 0, swExportPDFData, lErrors, lWarnings

       

       

      i = i + 3

      Loop

       

       

       

       

      End Sub