Create Visio document from Excel using VBA

bydganwil

New Member
Hi there,

I have a spreadsheet with 20 rows of data with just 1 column. I need to create a visio document for each row and display the data within it. I am not concerned about how the data is displayed within Visio.

I hope somebody can help.

Rob
 

pbornemeier

Well-known Member
Try this
Code:
Option Explicit

Sub VisioFromExcel()

    Dim AppVisio As Object
    Dim oCharacters As Object
    Dim lX As Long
    Dim sChar As String
    
    Set AppVisio = CreateObject("visio.application")
    AppVisio.Visible = True
    
    For lX = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    
        AppVisio.Documents.AddEx "block_u.vst", 0, 0
        AppVisio.Windows.ItemEx(lX).Activate
        AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.Item("BLOCK_U.VSS").Masters.ItemU("Box"), 1.35, 9.8
        AppVisio.ActiveWindow.Page.Shapes.ItemFromID(1).CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = "20 pt"
        
        Set oCharacters = AppVisio.ActiveWindow.Page.Shapes.ItemFromID(1).Characters
        oCharacters.Begin = 0
        oCharacters.End = Len(oCharacters)
        sChar = Cells(lX, 1).Value
        oCharacters.Text = sChar

    
    Next
    
    Set oCharacters = Nothing
    Set AppVisio = Nothing
    
End Sub
 

azjd2009

New Member
This macro works fine but produces a new Visio drawing for each Excel cell in the range.

How would I modify the macro to Drop the shapes on the SAME Visio page? I don't care about positioning or if they cover up each other.

I want to copy ALL the shapes at one time, rather than having to open each Visio drawing and copy.

Thanks, Joe
 

pbornemeier

Well-known Member
All shapes on same page

Code:
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")
    AppVisio.Visible = True
    
    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
 

azjd2009

New Member
I tried that macro and got compile error "User-defined type not defined" on Dim vsoCharacters1 As Visio.Characters. I changed that to Dim vsoCharacters1 As Object.

Then got compile errors on visOpenRO not defined. My target is Visio 2007 Standard.

Thanks,

Joe
 

pbornemeier

Well-known Member
Open the VBA Editor and use Tools | References to add the reference to Microsoft Visio X.X Type Library. x.x depends on the version of Visio you have installed.
 

raj1234

New Member
Open the VBA Editor and use Tools | References to add the reference to Microsoft Visio X.X Type Library. x.x depends on the version of Visio you have installed.
Hi Phil,

Very useful example!!

I need to generate Visio Diagrams from Excelsheet as well. The excelsheet contains input and output from one node. Do you have any example which reads from excel all input node and output node and shows arrow link if it is input or output. I just need one shape diagram but arrow should refelect if it is an input or output.

Also, all the shapes should be placed at different locations on the page.

Thanks
 
Last edited:

Some videos you may like

This Week's Hot Topics

Top