Sub VisioFromExcel()
Dim AppVisio As Object
Dim vsoCharacters1 As Visio.Characters
Dim lX As Long
Dim dXPos As Double
Dim dYPos As Double
Dim xs As Double
Dim ys As Double
'Const visSectionCharacter = 3
'Const visCharacterSize = 7
Set AppVisio = CreateObject("visio.application")
AppVisio.Visible = True
AppVisio.Documents.AddEx "", visMSDefault, 0 'Open Blank Visio Document
AppVisio.Documents.OpenEx "Custom1.vssx", visOpenRO + visOpenDocked 'Add Basic Stencil
dXPos = AppVisio.ActivePage.PageSheet.Cells("PageWidth") / 2
dYPos = AppVisio.ActivePage.PageSheet.Cells("PageHeight") / 2
xs = 0
For lX = 1 To Cells(Rows.Count, 1).End(xlUp).Row
AppVisio.Windows.ItemEx(1).Activate
AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.Item("Customs1.vssx").Masters.ItemU("SVP"), dXPos +xs, dYPos
Set vsoCharacters1 = AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lX).Characters
vsoCharacters1.Begin = 0
vsoCharacters1.End = 0
vsoCharacters1.Text = CStr(Cells(lX, 1).Value)
Debug.Print vsoCharacters1.Text
AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lX).CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = "24 pt"
xs = xs + 1
Next
Set AppVisio = Nothing
End Sub
