Excel VBA在Visio中创建时间线

如何使用VBA脚本在Visio中创建时间线图？ 我正在尝试从excel中执行此操作。我已经编写了VBA脚本来打开visio图表并创建基本形状。我想创建一个时间线图。 与basic_.vss和visMSDefault类似，在创建时间线图时是否需要任何参数？ 下面是我正在使用的代码片段

Option Explicit

Sub VisioFromExcel()

Dim AppVisio As Object
Dim vsoCharacters1 As Visio.Characters
Dim lX As Long
Dim dXPos As Double
Dim dYPos As Double

'Const visSectionCharacter = 3
'Const visCharacterSize = 7

Set AppVisio = CreateObject("visio.application")
'Set AppVisio = CreateObject("VisioTimelineVBA")
AppVisio.Visible = True

AppVisio.Documents.AddEx "", visMSDefault, 0 'Open Blank Visio Document
'AppVisio.Documents.AddEx "", visMSDefault, 0 'Open Blank Visio Document
AppVisio.Documents.OpenEx "basic_u.vss", visOpenRO + visOpenDocked   'Add Basic Stencil

dXPos = AppVisio.ActivePage.PageSheet.Cells("PageWidth") / 2
dYPos = AppVisio.ActivePage.PageSheet.Cells("PageHeight") / 2

For lX = 1 To Cells(Rows.Count, 1).End(xlUp).Row


    AppVisio.Windows.ItemEx(1).Activate
    AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.Item("BASIC_U.VSS").Masters.ItemU("Square"), dXPos, dYPos

    Set vsoCharacters1 = AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lX).Characters
    vsoCharacters1.Begin = 0
    vsoCharacters1.End = 0
    vsoCharacters1.Text = CStr(Cells(lX, 1).Value)

    AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lX).CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = "36 pt"


Next

Set AppVisio = Nothing

End Sub

---

下面的代码适用于我

选项显式

子VisioFromExcel

Dim AppVisio As Object


Dim docsObj As Visio.Documents 
Dim DocObj As Visio.Document
Dim pagsObj As Visio.Pages


Set AppVisio = CreateObject("visio.application")

AppVisio.Visible = True

Set docsObj = AppVisio.Documents
Set DocObj = docsObj.Add("Timeline.vst")

Set pagsObj = AppVisio.ActiveDocument.Pages


Set AppVisio = Nothing

---

End Sub

您不需要删除一个正方形，您可以在Page对象上使用DrawRectangle方法，但是如果遇到性能问题，您可以使用DropMany方法删除一组正方形，这比一次删除或绘制一个正方形要快。Jon Fournier，这只是尝试创建visio页面的一个示例。谢谢你的建议。