Question

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

我的问题是：

是否可以以编程方式从.vstm文件中的VBA宏（Visio 2013）中删除所有宏，而不会导致VBA宏失败，如果是，我该怎么办？
如果无法进行1.，我如何强制以编程方式将Visio保存到.vsdx具有宏的图形（即保存忽略所有宏）
如果无法使用2.如何将当前图形（除宏之外的所有图形）复制到新图形中，然后该图形应该可以保存到.vsdx？

我尝试了以下内容：

使用VBProject.VBComponents.Item(index).CodeModule.DeleteLines删除所有行会导致宏失败并显示“缺少结束函数”（我已经检查过，并且在任何地方都没有丢失End Function，我的猜测是宏可能会删除尚未执行的代码，这反过来会导致此错误）
Save和SaveEX也不起作用，我得到“ VBProjects无法保存在无宏文件中”错误/消息，即使我在致电Application.AlertResponse = IDOK / 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

希望这有帮助。

从visio 2013文件中删除所有宏

1 个答案: