Save / Export all Shapes on Page as Images

Started by sunthun, April 06, 2012, 12:40:21 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.


I am sure this is already posted somewhere, but I cannot find it...

I need some code to SAVE ALL SHAPES ON PAGE AS IMAGES.  Like the post for
Export All Pages in Document meets the post for CallByName

I need every shape on the page be saved as an image file, and I would really, REALLY like for each file name to be determined by a Shape Data or User-Defined field.

Any help would be tremendously appreciated!!!



Well, sort of...
That is exporting the drawing; I want to export each shape on the page.


As in most methods in Visio vba, the export method is actually looking for an 'object'. It should also work with shapes even though the sample code demonstrates a page.



Right - so how would I modify that code to work for the selected shape?

Public Sub Export_Example()
Dim vsoPage As Visio.Page
Set vsoPage = ActivePage
vsoPage.Export ("C:\\myExportedPage.bmp")
End Sub


something like this

Option Explicit

Public Sub exportPageShapesAsPNG()

Dim strFileType As String
strFileType = ".png"

Dim visPage As Visio.Page
Dim visShape As Visio.Shape
Dim strShapeText As String
Dim strFilePath As String
strFilePath = "c:\temp\"
For Each visPage In Application.ActiveDocument.Pages
    For Each visShape In visPage.Shapes
     ' assumes some text to identify the shape has been entered
     strShapeText = visShape.Text
     ' replace any spaces with underscores
     strShapeText = Replace(strShapeText, " ", "_")
     exportShapeAsPNG visShape, strFilePath & strShapeText & strFileType
    Next visShape
Next visPage

MsgBox "Macro complete"

End Sub

Private Sub exportShapeAsPNG _
    (ByVal visShape As Visio.Shape, _
    ByVal strFile As String)

    On Error GoTo ErrHandler

    'Enable diagram services
    Dim DiagramServices As Integer
    DiagramServices = ActiveDocument.DiagramServicesEnabled
    ActiveDocument.DiagramServicesEnabled = visServiceVersion140

'Set the export resolution to the printer resolution at 600 x 600 pixels/inch
Application.Settings.SetRasterExportResolution visRasterUsePrinterResolution, 600#, 600#, visRasterPixelsPerInch
'Set the export size to custom 2 x 2 inches
Application.Settings.SetRasterExportSize visRasterFitToCustomSize, 2#, 2#, visRasterInch
'Set the data format to Interlace
Application.Settings.RasterExportDataFormat = visRasterInterlace
'Set the color format to 24-bit color
Application.Settings.RasterExportColorFormat = visRaster24Bit
'Do not rotate the image
Application.Settings.RasterExportRotation = visRasterNoRotation
'Don't flip the image
Application.Settings.RasterExportFlip = visRasterNoFlip
'Set the background color
Application.Settings.RasterExportBackgroundColor = 14798527
'Set the transparency color
Application.Settings.RasterExportTransparencyColor = 13269045
'Use the transparency color
Application.Settings.RasterExportUseTransparencyColor = True

    visShape.Export strFile
    GoTo ExitHandler

    MsgBox Err.Description
    'Restore diagram services
    ActiveDocument.DiagramServicesEnabled = DiagramServices

End Sub


Al, you angel, that did it!
I just changed visShape.Text to visShape.Name, and instant gratification!

Your help is truly appreciate.  Thanks!!!