从 visio 2013 文件中删除所有宏

Question

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

我的问题是：

是否可以通过编程方式从 .vstm 文件中的 VBA 宏 (Visio 2013) 中删除 all 宏本身不会导致 VBA 宏失败，如果是，我该怎么做？
如果 1. 不可能，我如何以编程方式强制 Visio 保存到 .vsdx 具有宏的绘图（即保存时忽略所有宏）
如果 2. 不可行，我如何将当前绘图（除宏之外的所有内容）复制到新绘图，然后应该可以将其保存到 .vsdx？

我尝试了以下方法：

删除带有 VBProject.VBComponents.Item(index).CodeModule.DeleteLines 的所有行会导致宏失败并显示“End Function is missing”（我已经检查过并且没有丢失End Function任何地方，我的猜测是宏可能删除了尚未执行的代码，进而导致此错误）
Save 和 SaveEX 也不起作用，我得到一个“VBProjects cannot be saved in macro-free files” error/message，即使我在调用 Save / SaveEx.

Application.AlertResponse = IDOK

下面是示例代码。

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 删除模块的代码/class 通过 Document_DocumentCreated 等事件启动的模块。我能做到的最好的是删除 ThisDocument vba visio 对象的内容，但是模块/ class 模块中的所有代码都不可删除（请注意，如果手动调用宏，所有内容工作起来很有魅力，但这不是我想要实现的目标。
将从 vstm 模板实例化的绘图保存为无宏 vsdx 文件。

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

不是将数据源加载到从 vstm 文件实例化的绘图中，而是让宏执行以下操作：
1. select已实例化的绘图页面上出现的所有形状
2. 将他们分组
3. 复制它们
4. 创建一个新文档
5. 设置新文档的页面（方向、大小、禁用对齐和粘贴）
6. 将组粘贴到新建文档的第一页
7. 将绘图置于新文档的中心
然后将数据源加载到新创建的文档中，并将 link 数据加载到现有的形状中
最后您可以将新文档另存为vsdx

有很多形状（超过 400 个）这需要一些时间（大约 10 秒），但它有效。

这里是生成文档的class模块的代码。

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

希望对您有所帮助。

从 visio 2013 文件中删除所有宏

Remove all macros from a visio 2013 file

vba

visio