Matt Zellmer

Macro to Save All Individual Sheets as .PNGs

Discussion created by Matt Zellmer on Mar 11, 2020
Latest reply on Mar 11, 2020 by Matt Zellmer

I modified a macro for saving out drawings to separate PDFs so that it would output to PNGs, not the most elegant but the PDF macro works well. For some reason when I run this macro it saves out the individual PNGs and names them each as the separate sheets names but the contents are all the same.

Option Explicit
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.ExportPdfData
Dim lErrors As Long
Dim lWarnings As Long
Dim Path As String
Dim Revision As String

Sub Main()
Set swApp = Application.SldWorks
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
Set swSheet = swDraw.GetCurrentSheet

' Clear Selection
swModel.ClearSelection2 True

' Zoom To Sheet
swModel.Extension.ViewZoomToSheet

' Redraw
swModel.GraphicsRedraw2

'Set Path
Path = "O:\Temp"

'Set Sheet name
vSheetNameArr = swDraw.GetSheetNames
For Each vSheetName In vSheetNameArr

'Save Files
Set swExportPDFData = swApp.GetExportFileData(1)
swExportPDFData.SetSheets swExportData_ExportSpecifiedSheets, vSheetName
swModel.Extension.SaveAs Path & "\" & vSheetName & ".Png", 0, 0, swExportPDFData, lErrors, lWarnings

Next vSheetName

End Sub

Any help is appreciated,

Thanks

Outcomes