Excel VBA 更新 Visio 网络图模板

Question

我正在为我们企业中的多个站点创建图表，作为实施新技术的一部分。我一直在 Excel 文档中收集信息，并从该文档中我已经能够使用 VBA 更新各种 Word 文档和 Excel 文档，我的电子表格的一部分图片以及可以在下面找到 Visio 模板示例和所需的最终状态。

在搜索多个网站后，我找到了以下将打开 Visio 模板的代码，但我似乎无法让它按预期更新值。据我所知，我似乎正在经历各种形状，正如我所提到的，这些值没有按预期更新。

在此先感谢您的帮助和建议。

Sub UpdateVisioTemplate()
Dim vDocs As Visio.Documents  'Documents collection of instance.
Dim vsoDoc As Visio.Document  'Document to work in
Dim vsoPage As Visio.Page     'Page to work in.
Dim vsoPages As Visio.Pages   'Pages collection of document.
Dim vApp As Visio.Application 'Declare an Instance of Visio.
Dim vsoShape As Visio.Shape   'Instance of master on page.
Dim vsoCharacters As Visio.Characters
Dim DiagramServices As Integer

Dim VarRow As Long
Dim FileName, DocName, VarName, VarValue, SiteID, SiteType, Wave, SiteName As String
'Dim vContent As Word.Range
With ActiveSheet
    DocName = .Cells(1, 6).Value
    SiteType = .Cells(1, 25).Value
    SiteID = .Cells(20, 5).Value
    SiteName = .Cells(21, 5).Value
            
    On Error Resume Next  'Check if Visio is already running
    'Set vApp = CreateObject("Visio.Application")
    Set vApp = GetObject(, "Visio.Application")
    If Err.Number <> 0 Then    'not equal to 0
        Err.Clear
        Set vApp = CreateObject("Visio.Application")
    End If
    vApp.Visible = True
    Set vDocs = vApp.Documents.OpenEx(DocName, &H1)
    '(DocName)
    'Set vDocs = vApp.Documents.Open(DocName)
    Set vsoPages = vApp.ActiveDocument.Pages
    
    DiagramServices = vApp.ActiveDocument.DiagramServicesEnabled
    vApp.ActiveDocument.DiagramServicesEnabled = visServiceVersion140

    LastRow = .Range("A999").End(xlUp).Row
    For Each vsoPage In vsoPages
        For VarRow = 2 To LastRow 'from Row 2 to the last row
            For Each vsoShape In vsoPage.Shapes
                VarName = .Cells(VarRow, 1).Value  'VariableName
                VarValue = .Cells(VarRow, 2).Value 'VariableValue
                If Len(VarValue) = 0 Then   'If the variable value is blank, keep the variable in place
                    VarValue = .Cells(VarRow, 1).Value
                End If
                Set vsoCharacters = vsoShape.Charaters
                vsoCharacters.Text = Replace(vsoCharacters.Text, VarName, VarValue)  'Find and replace the variables with the appropriate value
            Next vsoShape
        Next VarRow
    Next vsoPage
End With 'Active Sheet
vDoc.SaveAs (SiteID & ".vsd")
End Sub

Sample of Excel Data

Visio Diagram Template

Visio Diagram Final

Answer 1

我注意到的一件事是在线 Set vsoCharacters = vsoShape.Charaters - 后者应该是 vsoShape.Characters 而不是 Charaters - 因为它基本上设置为空白（无），然后有'replace' 没有任何变化，也没有任何变化。

之所以没有出现，是因为 'on error resume next' 声明是在较早的时候进行的，它抑制了错误消息并继续进行。

Excel VBA 更新 Visio 网络图模板

Excel VBA to update a Visio network diagram template

excel

vba

visio