从 visio 2013 文件中删除所有宏

Question

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

我的问题是：

1. 是否可以以编程方式从 .vstm 文件本身中的 VBA 宏 (Visio 2013) 中删除 all 宏而不导致 VBA 宏失败，如果是，如何我可以吗？

2. 如果 1. 不可能，我如何以编程方式强制 Visio 将具有宏的绘图保存到 .vsdx（即保存忽略所有宏）

3. 如果 2. 不可能，我如何将当前图形（除宏之外的所有内容）复制到新图形，然后应该可以将其保存到 .vsdx？

我尝试了以下方法：

1. 使用VBProject.VBComponents.Item(index).CodeModule.DeleteLines 删除所有行会导致宏失败，并显示“End Function is missing”（我已经检查过，没有任何地方缺少End Function，我的猜测是该宏可能会删除尚未执行的代码，从而导致此错误）

2. Save 和 SaveEX 也不起作用，我收到“VBProjects 无法保存在无宏文件中”错误/消息，即使我添加了 @987654333 @ 之前调用Save / SaveEx。

下面是一个示例代码。

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 vba visio 对象的内容，但是模块/类模块中的所有代码都不可删除​​（请注意，如果手动调用宏，一切都像一个魅力，但这不是什么我想实现）。
• 将从vstm 模板实例化的绘图保存为无宏vsdx 文件。

什么是可能的（并且是我对问题第三部分的解决方案）：

• 不要将数据源加载到从vstm 文件实例化的图形中，而是让宏执行以下操作：

  1. 选择出现在已实例化的绘图页面上的所有形状
  2. 将它们分组
  3. 复制它们
  4. 创建一个新文档
  5. 设置新文档的页面（方向、大小、禁用对齐和粘合）
  6. 将该组粘贴到新创建文档的第一页
  7. 将绘图置于新文档的中心

• 然后将数据源加载到新创建的文档中，并将数据链接到现有的 Shapes

• 最后您可以将新文档另存为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

希望这会有所帮助。