AnsweredAssumed Answered

how to save sheets separately to pdf in vba

Question asked by Hank Costner on Feb 1, 2018
Latest reply on Feb 8, 2018 by 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

Outcomes