从visio 2013文件中删除所有宏

Question

我有一个Viso 2013 .vstm文件，它在文档创建时启动一个VBA宏(当用户手动打开模板时，模板实例化)。此宏填充从数据源创建的绘图。完成后，我想以编程方式(从VBA)保存已生成的作为.vsdx文件的绘图，即使用用于填充正在删除的绘图的所有VBA宏。

我的问题是：

1. 是否可以通过编程方式从位于文件本身的VBA宏(Visio2013)中删除所有宏，而不会导致.vstm宏失败，如果是，我如何做到？
2. 如果不可能，如何以编程方式强制Visio将具有宏的绘图保存到.vsdx (即保存忽略所有宏)
3. 如果2.是不可能的，我如何将当前绘图(宏除外)复制到新的绘图中，然后将其保存到.vsdx

我尝试了以下几点：

1. 用VBProject.VBComponents.Item(index).CodeModule.DeleteLines删除所有行会导致宏失败，并带有"End函数缺失“(我已经检查过，而且在任何地方都没有缺少End Function，我猜宏可能删除尚未执行的代码，从而导致此错误)。
2. Save和SaveEX也不起作用，即使在调用Save / SaveEx之前添加了Application.AlertResponse = IDOK，也会出现"VBProjects不能保存在没有宏的文件中“的错误/消息。

下面是一个示例代码。

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

启动宏执行的代码是以下事件：

' 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

我终于找到了一种实现我想要的东西的方法:从启用宏的绘图中生成一个没有宏的visio绘图。

根据我的理解，不可能的是：

• 让vba代码移除通过事件(如Document_DocumentCreated )启动的模块/类模块。我能做到的最好的就是删除ThisDocument visio对象的内容，但是模块/类模块中的所有代码都是不可移动的(请注意，如果这个宏是手动调用的，那么一切都像魅力一样工作，但这不是我想要实现的)。
• 将从vstm模板实例化的绘图保存为没有宏的vsdx文件.

什么是可能的(也是我对问题第三部分的解决办法)：

• 与其将数据源加载到从vstm文件实例化的绘图中，不如让宏执行以下操作：

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

​

• 然后将数据源加载到新创建的文档中，并将数据链接到现有形状。
• 最后，您可以将新文档保存为vsdx

对于许多形状(超过400)，这需要一些时间(约10秒)，但它的工作。

下面是生成文档的类模块的代码。

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

希望这能有所帮助。