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

Excel数据示例

Visio图表模板

Visio图表最终

Answer 1

我注意到的一件事是在Set vsoCharacters = vsoShape.Charaters行-后者应该是vsoShape.Characters而不是Charaters-因为它基本上被设置为空白(没有(，所以没有什么可以"替换"的，也没有任何更改。

之所以没有出现这种情况，是因为"on error resume next"语句是早些时候发出的，它会抑制错误消息并简单地继续。