Question

我们如何使用VBA脚本在Visio中创建时间线图？我试图从excel这样做。我编写了VBA脚本来打开visio图并创建一个基本形状。我想创建一个时间表图。与basic_u.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

Answer 1

以下代码对我有用。

选项明确

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

VBA在Visio中创建时间轴

1 个答案: