Remove all macros from a visio 2013 file

Question

I have a Viso 2013 .vstm file that launches a VBA macro on document creation (template instanciation when a user opens the template manually). This macro populates the created drawing from a datasource. When finished, I would like to save programatically (from VBA) the drawing that has been generated as a .vsdx file, i.e. with all VBA macros that were used to populate the drawing being removed.

My questions are:

1. Is it possible to remove all macros programatically from a VBA macro (Visio 2013) which is in the .vstm file itself without causing the VBA Macro to fail and if yes, how can I do it ?

2. If 1. is not possible, how can I force programatically Visio to save to .vsdx a drawing that has macros (i.e. save ignoring all macros)

3. If 2. is not possible, how can I copy current drawing (everything except macros) to a new Drawing which should then be savable to .vsdx?

I have tried the following:

1. Deleting all lines with VBProject.VBComponents.Item(index).CodeModule.DeleteLines causes the macro to fail with "End Function is missing" (I have checked and there is no missing End Function anywhere, my guess is that the macro probably deletes the code that hasn't been executed yet, which in turn causes this error)

2. Save and SaveEX do not work either, I get a "VBProjects cannot be saved in macro-free files" error/message, even if I add a Application.AlertResponse = IDOK prior to the call to Save / SaveEx.

Here follows a sample code.

Private Sub RemoveVBACode()
    ' If document is a drawing remove all VBA code
    ' Works fine however execution fails as all code has been deleted (issue 1)
    If ActiveDocument.Type = visTypeDrawing Then
        Dim i As Integer
        With ActiveDocument.VBProject
            For i = .VBComponents.Count To 1 Step -1
                .VBComponents.Item(i).CodeModule.DeleteLines 1, .VBComponents.Item(i).CodeModule.CountOfLines
            Next i
        End With
        On Error GoTo 0
    End If
End Sub

Private Sub SaveAsVSDX(strDataFilePath As String)
    RemoveVBACode
    Application.AlertResponse = IDOK
    ' Next line fails at runtime (issue 2), the same occurs when using Save
    ThisDocument.SaveAsEx strDataFilePath, visSaveAsWS + visSaveAsListInMRU
    Application.AlertResponse = 0
End Sub

The code that starts the execution of the Macro is the following event:

' This procedure runs when a Visio document is
' created. I.e., when the template (.vstm) is opened.
Private Sub Document_DocumentCreated(ByVal Doc As IVDocument)
    ' ...
    SaveAsVSDX (strDataFilePath)
    ' ...
End Sub

Answer 1

I finally found a way to achieve what I wanted : generate a macro-less visio drawing, from a macro-enabled drawing.

What IS NOT possible from my understanding :

• Have vba code that removes modules / class modules that is launched through an event such as Document_DocumentCreated. The best I could achieve is to remove the content of ThisDocument vba visio object, but all code in modules / class modules were not removable (note that if the macro is called manually, everything works like a charm, but this was not what I wanted to achieve).
• Saving a a drawing instanciated from a vstm template as a macro-less vsdx file.

What IS possible (and is my solution to the third part of the question) :

• Instead of loading datasource into the drawing instanciated from the vstm file, have the macro do the following:

  1. select all shapes that appear on the page of the drawing that has been instanciated
  2. group them
  3. copy them
  4. create a new Document
  5. setup the page of the new document (orientation, size, disable snapping and gluing)
  6. paste the group into the first page of the newly created document
  7. center the drawing on the new document

• Then load the datasource into the newly created document and link data to existing Shapes

• Finaly you can save the new document as vsdx

With lots of shapes (more than 400) this takes some time (around 10 seconds), but it works.

Here is the code of the class module that generates the document.

Option Explicit
'Declare private variables accessible only from within this class
Private m_document As Document
Private m_dataSource As DataSourceFile
Private m_longDataRecordsetID As Long

Public Function Document() As Document
    Set Document = m_document
End Function

Private Sub CreateDocument()
    ' I consider here that the active window is displaying the diagram to
    ' be copied
    ActiveWindow.ViewFit = visFitPage
    ActiveWindow.SelectAll

    Dim activeGroup As Shape
    Set activeGroup = ActiveWindow.Selection.Group
    activeGroup.Copy
    ActiveWindow.DeselectAll

    Set m_document = Application.Documents.Add("")
    ' I need an A4 document
    m_document.Pages(1).PageSheet.CellsSRC(visSectionObject, visRowPage, visPageWidth).FormulaU = "297 mm"
    m_document.Pages(1).PageSheet.CellsSRC(visSectionObject, visRowPage, visPageHeight).FormulaU = "210 mm"
    m_document.Pages(1).PageSheet.CellsSRC(visSectionObject, visRowPrintProperties, visPrintPropertiesPageOrientation).FormulaForceU = "2"
    m_document.Pages(1).PageSheet.CellsSRC(visSectionObject, visRowPrintProperties, visPrintPropertiesPaperKind).FormulaForceU = "9"
    m_document.SnapEnabled = False
    m_document.GlueEnabled = False
    m_document.Pages(1).Paste
    m_document.Pages(1).CenterDrawing
End Sub

Private Sub LoadDataSource()
    Dim strConnection As String
    Dim strCommand As String
    Dim vsoDataRecordset As Visio.DataRecordset
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                       & "User ID=Admin;" _
                       & "Data Source=" + m_dataSource.DataSourcePath + ";" _
                       & "Mode=Read;" _
                       & "Extended Properties=""HDR=YES;IMEX=1;MaxScanRows=0;Excel 12.0;"";" _
                       & "Jet OLEDB:Engine Type=34;"
    strCommand = "SELECT * FROM [Data$]"
    Set vsoDataRecordset = m_document.DataRecordsets.Add(strConnection, strCommand, 0, "Data")
    m_longDataRecordsetID = vsoDataRecordset.ID
End Sub

Private Function CheckDataSourceCompatibility() As Boolean
    Dim visRecordsets As Visio.DataRecordsets
    Dim varRowData As Variant
    Set visRecordsets = m_document.DataRecordsets
    varRowData = visRecordsets(1).GetRowData(1)
    If varRowData(3) = "0.6" Then
        CheckDataSourceCompatibility = True
    Else
        MsgBox "Using invalid DataSource version, aborting. You shoud use data format version 0.6."
        CheckDataSourceCompatibility = False
    End If
End Function

Private Sub LinkDataToShapes()
    Application.ActiveWindow.SelectAll
    Dim ColumnNames(1) As String
    Dim FieldTypes(1) As Long
    Dim FieldNames(1) As String
    Dim IDsofLinkedShapes() As Long
    ColumnNames(0) = "ID"
    FieldTypes(0) = Visio.VisAutoLinkFieldTypes.visAutoLinkCustPropsLabel
    FieldNames(0) = "ID"
    Application.ActiveWindow.Selection.AutomaticLink m_longDataRecordsetID, ColumnNames, FieldTypes, FieldNames, 10, IDsofLinkedShapes
    Application.ActiveWindow.DeselectAll
End Sub

Public Function GenerateFrom(dataSource As DataSourceFile) As Boolean
    Set m_dataSource = dataSource

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

    ' Create a new document that contains only shapes
    CreateDocument

    ' Load datasource
    LoadDataSource

    ' Check datasource conformity
    If CheckDataSourceCompatibility Then
        ' Link data recordset to Visio shapes
        LinkDataToShapes
        GenerateFrom = True
    Else
        GenerateFrom = False
    End If

    'Restore diagram services
    ActiveDocument.DiagramServicesEnabled = DiagramServices
End Function

Hope this helps.