Create Visio document from Excel using VBA

[bydganwil]

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

 

[muthus80]

Re: Create Visio 2010 document from Excel 2013 using VBA

Hi Phil,

Can you help how to convert the excel row data into visio flowchart, each row column needs to be converted into a box in visio.

For Example in Excel:

Step1

Step2

Step3

<colgroup><col width="64" style="width:48pt"> </colgroup><tbody>
</tbody>

The above has to be converted to flowchart with connector. Any help really appreciated since I am entirely new to MS technologies.

 

[pbornemeier]

Re: Create Visio 2010 document from Excel 2013 using VBA

Option Explicit
Dim AppVisio As Object

Sub CreateLinkedVisioBoxesForRow2AndDown()

    Dim lLastRow As Long
    Dim lRowIndex As Long
    Dim lLastColumn As Long
    Dim aryRowData() As Variant
    Dim lDrawingCount As Long
    
    lLastRow = Cells(Rows.Count, 1).End(xlUp).Row
    For lRowIndex = 2 To lLastRow   'Assuming headers.  If no headers, change 2 to 1
        lDrawingCount = lDrawingCount + 1
        Application.StatusBar = "Creating Drawing " & lDrawingCount
        lLastColumn = Cells(lRowIndex, Columns.Count).End(xlToLeft).Column
        aryRowData = Range(Cells(lRowIndex, 1), Cells(lRowIndex, lLastColumn)).Value
        DropStringOfBoxes aryRowData
    Next
    
    MsgBox lDrawingCount & " drawing" & IIf(lDrawingCount > 1, "s", "") & " created.", , "Complete"
End Sub


Sub DropStringOfBoxes(aryRange() As Variant)
    'Given an array, create a grid of vision boxes connected in order
    
    'Dim aryRange() As Variant '(1,1)...(1,N)
    Dim aryContents() As Variant    '0...N
    Dim lAryIndex As Long
    Dim lAryRangeIndex As Long
    Dim lShapeIndex As Long
    Dim sngX As Single
    Dim sngY As Single
    Dim sngDeltaX As Single
    Dim sngDeltaY As Single
    Dim lLastDropIndex As Long
    Dim lCurrDropIndex As Long
    Dim bAllInSameVisio As Boolean
    
    bAllInSameVisio = True
    
    'If using hard-coded array
'    aryContents = Array("AAAAAAAAAA", "BBBBBBBBBB", "CCCCCCCCCC", "DDDDDDDDDD", "EEEEEEEEEE", "FFFFFFFFFF", "GGGGGGGGGG")
    
    'If using a selection as input (Only takes cells in first area, read Left to Right, Top to Bottom
'    aryRange = Selection.Value
'    For lAryIndex = 1 To Selection.Cells.Count
'        ReDim Preserve aryContents(0 To lAryRangeIndex)
'        aryContents(lAryRangeIndex) = Selection.Cells(lAryIndex)
'        lAryRangeIndex = lAryRangeIndex + 1
'    Next

    'If using input parameter array
    For lAryIndex = LBound(aryRange, 2) To UBound(aryRange, 2)
        ReDim Preserve aryContents(0 To lAryRangeIndex)
        aryContents(lAryRangeIndex) = aryRange(1, lAryIndex)
        lAryRangeIndex = lAryRangeIndex + 1
    Next
    
    sngDeltaX = 2
    sngDeltaY = 1.25
    sngX = 1
    sngY = 10.25
    
    If bAllInSameVisio Then
        'Is Visio already running
        On Error Resume Next
        ' Check whether PowerPoint is running
        Set AppVisio = GetObject(, "Visio.Application")
        If AppVisio Is Nothing Then
            ' Visio is not running, create new instance
            Set AppVisio = CreateObject("visio.Application")
            AppVisio.Visible = True
        End If
    Else
        'Open new copy of Visio
        Set AppVisio = CreateObject("visio.Application")
        AppVisio.Visible = True
    End If
    
    'Add New Drawing
    AppVisio.Documents.AddEx "basicd_u.vst", 0, 0
    'Open Stencils if other shapes are required
    'AppVisio.Documents.OpenEx "comps_u.vss", 2 + 4  'visOpenRO + visOpenDocked
    'AppVisio.Documents.OpenEx "periph_u.vss", 2 + 4 'visOpenRO + visOpenDocked
    'AppVisio.Documents.OpenEx "basic_u.vss", 2 + 4  'visOpenRO + visOpenDocked
    
    'Drop first shape
    AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.Item("BASIC_U.VSS").Masters.ItemU("Rectangle"), sngX, sngY
    lLastDropIndex = AppVisio.ActiveWindow.Selection.PrimaryItem.ID
    SetShapeText lLastDropIndex, CStr(aryContents(0))
    
    For lShapeIndex = LBound(aryContents) + 1 To UBound(aryContents)
        'Calculate Position
        sngY = sngY - sngDeltaY
        If sngY < 1 Then
            sngY = 10.25
            sngX = sngX + sngDeltaX
        End If
        
        'Save index of last dropped stencil
        lLastDropIndex = AppVisio.ActiveWindow.Selection.PrimaryItem.ID
        
        'Drop Current stencil
        AppVisio.ActiveWindow.Page.Drop AppVisio.Documents.Item("BASIC_U.VSS").Masters.ItemU("Rectangle"), sngX, sngY
        lCurrDropIndex = AppVisio.ActiveWindow.Selection.PrimaryItem.ID
        SetShapeText lCurrDropIndex, CStr(aryContents(lShapeIndex))
        
        'Connect Last to Current
        AppVisio.ActivePage.Shapes.ItemFromID(lLastDropIndex).AutoConnect AppVisio.ActivePage.Shapes.ItemFromID(lCurrDropIndex), 0
        
        'Save Current as Last (for next loop)
        lLastDropIndex = lCurrDropIndex
        
    Next
    Set AppVisio = Nothing
End Sub

Sub SetShapeText(lShapeID As Long, sEntry As String)
    'Add Text to Shape
    Dim vsoCharacters1 As Object
    
    Set vsoCharacters1 = AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).Characters
    vsoCharacters1.Begin = 0
    vsoCharacters1.End = 0
    vsoCharacters1.Text = sEntry
    AppVisio.ActiveWindow.Page.Shapes.ItemFromID(lShapeID).CellsSRC(3, 0, 7).FormulaU = "18 pt"     'visSectionCharacter, 0, visCharacterSize
    
    Set vsoCharacters1 = Nothing

End Sub

 

[Kitesurfer]

Is it possible to update existing Visio diagrams from Excel spreadsheet?

For example we have columns with different data and I want to populate existing Visio diagrams with device names and IP addresses from the excel table.

Basically I need to understand how I can create Visio diagram with variables which later can be populated with data coming from Excel spreadsheet.

 

[pbornemeier]

This thread has code that created a Visio document from an Excel worksheet:
http://www.mrexcel.com/forum/excel-...io-horizontal-swimlane-excel-activesheet.html
You would have to add code to update the worksheet with the Shape ID (or if all if the shapes have unique text, you could search on that) to allow the new code to find the shape to update its data.

 

[ankurranka]

Hi pbornemeier

I have around 100 of different excel ,from this i want to convert all them into Visio flow chart,

I have a code which create Visio flow diagram programattically.

just i need to feed the column text into code

please see the below code for that

But i want to convert the excel into visio flow chart
is there any tool/ code available which can convert the same


Please see the Visio VBA script which i have used

Sub FlowChartInVisio()


  Const FlowchartTemplateName$ = "Basic Flowchart.vst"
  Const FlowchartStencilName$ = "BASFLO_M.VSS"
  Const MasterProcessName$ = "Process"
  Const MasterDecisionName$ = "Decision"
  Const MasterTerminatorName$ = "Terminator"
 


  Dim doc As Visio.Document
    Dim vsoShape1 As Visio.Shape
    Dim shapeIDArray() As Integer
    Dim searching As Boolean
    Dim vsoPage As Visio.Page
    Dim shapeList
    
    
    
  Dim docFlowTemplate As Visio.Document
  Dim docFlowStencil As Visio.Document
  
  
   Set docFlowTemplate = Visio.Documents. _
  Add(FlowchartTemplateName)  ' New document will be added
  
  
  Set vsoPage = Application.ActivePage  ' page will get activated
  








      
      
      'Shapes("Start/End")   ---     Process initiation
      
      
      






  For Each doc In Visio.Documents              ' it will search the open document for flowchart stensil
    If (doc.Name = FlowchartStencilName) Then
      Set docFlowStencil = doc
      Exit For
    End If
  Next
  Set doc = Nothing


  Dim mstProcess As Visio.Master
  Dim mstDecision As Visio.Master
  Dim conn As Variant


  Set mstProcess = _
      docFlowStencil.Masters.ItemU(MasterProcessName)
  Set mstDecision = _
      docFlowStencil.Masters.ItemU(MasterDecisionName)
  Set mstTerminator = _
      docFlowStencil.Masters.ItemU(MasterTerminatorName)
  
      
      
  Set conn = Visio.Application.ConnectorToolDataObject




  Const NumShapes% = 15


  Const DecisionStepNumber% = 4


  Dim i As Integer
  Dim x As Double, y As Double


  Const dx# = 2.5
  Const dy# = 1.5


  Dim pg As Visio.Page
  Dim shpNew As Visio.Shape
  Dim shpLast As Visio.Shape
  Dim shpConn As Visio.Shape
  Dim shpDec As Visio.Shape




  Set pg = docFlowTemplate.Pages.Item(1)




  x = pg.PageSheet.CellsU("PageWidth").ResultIU / 3
  y = pg.PageSheet.CellsU("PageHeight").ResultIU - 2


  For i = 1 To NumShapes
    If i = DecisionStepNumber Then
      Set shpNew = pg.Drop(mstDecision, x, y)
     shpNew.Text = " Whether site is WLA ATM ?"
      Set shpDec = shpNew
    Else
      If i = 1 Then
     Set shpNew = pg.Drop(mstTerminator, x, y)
      shpNew.Text = "Start"
    Else
      If i = 2 Then
     Set shpNew = pg.Drop(mstProcess, x, y)
      shpNew.Text = "L9"
    Else
     If i = 3 Then
     Set shpNew = pg.Drop(mstProcess, x, y)
      shpNew.Text = "L8"
    Else
     If i = 5 Then
     Set shpNew = pg.Drop(mstProcess, x, y)
      shpNew.Text = "L7"
    Else
     If i = 6 Then
      Set shpNew = pg.Drop(mstProcess, x, y)
      shpNew.Text = "L6"
    Else
     If i = 7 Then
     Set shpNew = pg.Drop(mstDecision, x, y)
     shpNew.Text = "L5"
     Set shpDec = shpNew
    Else
     If i = 8 Then
     Set shpNew = pg.Drop(mstProcess, x, y)
     shpNew.Text = "L4"
    Else
   If i = 9 Then
     Set shpNew = pg.Drop(mstDecision, x, y)
     shpNew.Text = "L3"
     Set shpDec = shpNew
     Else
   If i = 10 Then
    Set shpNew = pg.Drop(mstProcess, x, y)
     shpNew.Text = "L2"
     Set shpDec = shpNew
     Else
   If i = 11 Then
    Set shpNew = pg.Drop(mstDecision, x, y)
     shpNew.Text = "L1"
     Set shpDec = shpNew
   Else
   Set shpNew = pg.Drop(mstTerminator, x, y)
      shpNew.Text = "End"
      Set shpDec = shpNew
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    End If
    


    shpNew.Cells("Prop.Cost").ResultIU = i
    shpNew.Cells("Prop.Duration"). _
    Result(Visio.VisUnitCodes.visElapsedHour) = i


    If (i <> 1) Then
      Set shpConn = pg.Drop(conn, 0, 0)
     
      If (i = DecisionStepNumber + 1) Then
        
        Call shpConn.CellsU("BeginX"). _
        GlueTo(shpDec.CellsU("Connections.X2"))
      Else
       
        Call shpConn.CellsU("BeginX"). _
        GlueTo(shpLast.CellsU("PinX"))
      End If
      Call shpConn.CellsU("EndX"). _
        GlueTo(shpNew.CellsU("PinX"))
    End If




    Set shpLast = shpNew


    Select Case i
    Case DecisionStepNumber
      x = x + dx
    Case (DecisionStepNumber + 1)
      x = x - dx
      y = y - dy
      shpConn.Text = "No"
      Set shpLast = shpDec
      Case Else
      y = y - dy
    End Select




Next i




  Visio.ActiveWindow.DeselectAll




  Call Visio.Windows. _
  Arrange(Visio.visArrangeTileVertical)


End Sub

Request you to please help in this




Thanks and Regards,
Ankur

 

[damswil]

I have used & modified the previous code with some success for what I am trying to do, but I am coming up with a problem. I am importing custom shapes from a custom stencil into a new drawing, and I am trying to get the first column of excel data to import into the 4th row of an existing custom property row (Prop.Row_4.Value). I feel like this should be pretty simple, but I don't really work much with excel in vba so I am kind of at a loss. Any help would be appreciated.

Thanks
- Dan

 

[sebhoo]

Hi everyone,

I have a problem with VBA that fits the subject of this post and I was hoping someone could help me out with this.

My excelfile has a lot of rows and three columns: the first column represents the name of the object (the objects are all processes), the second column represents the group to which this object is belonging and the thirs column stands for the total number of people working on this process.

So for example I have this part of my excelfile (it's in french and dutch):

Activiteiten ikv VZW le PAS	Action Sociale	0,4
Beheer gevonden voorwerpen	Action Sociale	0,5
Drankleveringen	Action Sociale	0,5
Hygiene	Action Sociale	0,9
Maaltijden aan huis	Action Sociale	4,0
Materiaalleveringen	Action Sociale	3,3
Pensioenen en gehandicapten	Action Sociale	1,9
Planning en beheer	Action Sociale	3,3
Sociale dienst met familiehulp	Action Sociale	18,4
Tewerkstelling en toelagen	Action Sociale	2,5
Uitdrijvingen	Action Sociale	2,3
Gérer les récupérations de créances.	Affaires juridiques	0,4
Avis juridiques	Affaires juridiques	0,8
Elaborer des textes réglementaires communaux	Affaires juridiques	0,2
Analyser et rédiger des conventions	Affaires juridiques	0,1
Gérer le contentieux	Affaires juridiques	0,7
Gérer les réclamations contre les taxes communales	Affaires juridiques	0,3

<colgroup><col span="2"><col></colgroup><tbody>
</tbody>

Now I would like to create a code that fits for every row the name in a shape (a small rectangle) and the value in the third column in another small rectangle within the rectangle with the name in it (in the right corner of the bigger rectangle). With the first code in this post I'm able to create every time a rectangle where the name fits in, but I'm not able to alse put the value in the corner of the same rectangle. I tried to create a new shape in favorites in visio. But then he puts three object in this predefined shape.

My second problem is that for every row, I would like to assign a random color to the shapes of the rows that belongs to the same group. So that all the object of the same group would get the same color, but different from the other groups

Could someone help me out with this please?

 

[Sayre]

Hi sebhoo, I made a version of pbornemeier's code that does something similar to what you ask, but not the exactly. When you mention shapes within shapes, containers are a good way to do that. My modification of the visio drawing script incorporates containers and putting shapes inside each container based on a list in excel.

Try out this code on your columns and see if you like the way containers can organize shapes. This will create a container for each group (2nd column, "Action Sociale", etc...) and put a shape in it for each process name (column 1), concatenated with the number of people working on it (column 3).

Sub draw_visio_with_containers()

'put process names into column A, group name into column B, number of people into column C


'turn off application functions like calculation, events, display alerts

    With Application
    .DisplayAlerts = False
    .EnableEvents = False
    '.ScreenUpdating = False
    End With

'define variables related to visio
    Dim AppVisio As Object
    Dim lLastArrayRow As Long
    Dim vArray As Variant
    
    Dim WS2 As Worksheet
    
    Dim bfound As Boolean
    Dim lX As Long, lY As Long, lZ As Long, lQ As Long
    
    Dim sngPageWidth As Single
    Dim sngPageHeight As Single
    Dim vsoSelection As Visio.Selection
    Dim lngShapeIDs() As Long
    Dim lngShapeID As Long
    Dim lngContainerIDs() As Long
    Dim lngContainerID As Long
    
    Dim sngShapeHCenter As Single
    Dim sngShapeVCenter As Single
    Dim sngPlotCount As Single
    Dim aryPlotted() As Variant
    Dim aryPlotted2() As Variant
    Dim IsInArray As Variant
    Dim vsoDoc1 As Visio.Document
    
    Dim shpData1 As String
    Dim cntrData1 As String
    Dim vsoPage As Visio.Page
    Dim vsoContainerShape As Visio.Shape
    Dim visShape As Visio.Shape
    Dim containerId As Variant
    Dim yoffset
    
'specify height/width for all regular shapes (not containers)
    Const sngShapeHeight As Single = 0.3
    Const sngShapeWidth As Single = 2

'define the last row with active data
lLastArrayRow = Cells(Rows.Count, 1).End(xlUp).Row

'open new instance of Visio application
Set AppVisio = CreateObject("visio.application")
AppVisio.Visible = True
    
    With AppVisio
    .ScreenUpdating = False
    End With
    
'Open new Visio document
AppVisio.Documents.AddEx "", visMSDefault, 0
AppVisio.ActiveWindow.Page.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageWidth).FormulaU = "11 in"
AppVisio.ActiveWindow.Page.PageSheet.CellsSRC(visSectionObject, visRowPage, visPageHeight).FormulaU = "17 in"
    
'Add required stencils
AppVisio.Documents.OpenEx "basflo_u.vss", visOpenRO + visOpenDocked
AppVisio.Documents.OpenEx "connec_u.vss", visOpenRO + visOpenDocked
    
'define vsoDoc1 variable as container stencil within this document
Set vsoDoc1 = AppVisio.Documents.OpenEx(AppVisio.GetBuiltInStencilFile(visBuiltInStencilContainers, visMSUS), visOpenHidden)
 
'define the area where new shapes/containers will be placed on the visio
sngPageWidth = AppVisio.ActivePage.PageSheet.Cells("pagewidth") '* 3
sngPageHeight = AppVisio.ActivePage.PageSheet.Cells("pageHeight") '* 3

'define range for array to be used later
vArray = ActiveSheet.Range(("A2:C" & Cells(Rows.Count, "A").End(xlUp).Row), Cells(lLastArrayRow, 1))

'this array will keep a record of all the shape names (as defined by vArray value) as they get created
ReDim Preserve aryPlotted(1 To 1)
    
    ReDim aryPlotted2(1 To 1)
    aryPlotted(1) = "xyzzy"
    
 'create a loop that iterates through rows (lX)
For lX = LBound(vArray, 1) To UBound(vArray, 1) '0 to X
    bfound = False
            
    'Compare to shapes just plotted
    For lZ = LBound(aryPlotted) To UBound(aryPlotted)
        If aryPlotted(lZ) = vArray(lX, 1) Then
            bfound = True
            Exit For
        End If
    Next
            
    If Not bfound Then  'If not then add it
            
    'define shape location (where will shape land on page when drawn)
        sngPlotCount = sngPlotCount + 1 'move down 2 vertical units each time a new shape is drawn
        sngPlotCount2 = (sngPlotCount * -1) + 4 'vertical starting plot position
        ReDim Preserve aryPlotted(1 To sngPlotCount)
        aryPlotted(sngPlotCount) = vArray(lX, 1) 'name of shape to be drawn

    With AppVisio.ActiveWindow.Page
        .Drop AppVisio.Documents.Item("BASFLO_U.VSS").Masters.ItemU("Process"), 2.25, sngPlotCount2 'draw basic shape and put it sngPlotCount2 vertical location on Visio page
        Set vsoSelection = AppVisio.ActiveWindow.Selection
                    
        Call vsoSelection.GetIDs(lngShapeIDs) 'get the ID of the shape just drawn and put it in array called 'lngShapeIDs'
                    
    'with the shape just drawn...
        With .Shapes.ItemFromID(lngShapeIDs(0))
            .CellsSRC(visSectionObject, visRowXFormOut, visXFormPinX).FormulaU = sngShapeHCenter 'move shape just drawn to its horizontal position
            .CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = sngShapeWidth 'modify shape width
            .CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = sngShapeHeight 'modify shape height
            .Characters.Text = vArray(lX, 1) & " - " & vArray(lX, 3) 'place text inside shape
            .Name = vArray(lX, 1) & " - " & vArray(lX, 3) 'name the shape
            .Data1 = vArray(lX, 2) 'this is needed to associate the shape to the container it will be in
        End With
        
    End With
        
    lQ = lX 'sync up lQ with current row that lX is on

    For lQ = LBound(aryPlotted2) To UBound(aryPlotted2)
               
        'If the value currently active in the loop (vArray) is not saved to the array called "aryPlotted2",
        'then create container for it and put selected shape in it, then call up the container shape ID for it and put it in array lngContainerIDs:
        If aryPlotted2(lQ) = "" Then aryPlotted2(lQ) = Chr(1)
                    
            IsInArray = (UBound(Filter(aryPlotted2, Chr(1) & vArray(lX, 2) & Chr(1))) > -1)
                    
                If Not IsInArray Then

                    aryPlotted2(lQ) = aryPlotted2(lQ) & vArray(lX, 2) & Chr(1)

                    AppVisio.ActivePage.DropContainer vsoDoc1.Masters.ItemFromID(2), AppVisio.ActiveWindow.Selection
                    Set vsoSelection = AppVisio.ActiveWindow.Selection
                    Call vsoSelection.GetIDs(lngContainerIDs)
                    
                    AppVisio.ActivePage.Shapes.ItemFromID(lngContainerIDs(0)).Text = vArray(lX, 2) 'place text inside container
                    AppVisio.ActivePage.Shapes.ItemFromID(lngContainerIDs(0)).Name = vArray(lX, 2) 'name the container
                    AppVisio.ActivePage.Shapes.ItemFromID(lngContainerIDs(0)).Data1 = vArray(lX, 2) 'place data in data1 field of container. Later portion of the script searches for this for shape placement in container
                    AppVisio.ActiveWindow.Selection.SetContainerFormat visContainerFormatFitToContents 'adjust shape of container to fit around the shape in it
                    
                    Exit For
                    
                Else
                    
                    'move shape to correct existing container location and add the shape to that container:
                    Set vsoSelection = AppVisio.ActiveWindow.Selection
                    Call vsoSelection.GetIDs(lngShapeIDs) 'get the ID of the new shape just drawn
            
                    shpData1 = AppVisio.ActivePage.Shapes.ItemFromID(lngShapeIDs(0)).Data1 'get the text string from Data1 field of the shape and define it as "shpData1"
    
                    Set vsoPage = AppVisio.ActivePage

                    'loop through all containers on the visio page...
                    For Each containerId In vsoPage.GetContainers(visContainerIncludeNested)
                        Set vsoContainerShape = vsoPage.Shapes.ItemFromID(containerId)
                        cntrData1 = AppVisio.ActivePage.Shapes.ItemFromID(containerId).Data1 'get the text string from Data1 field of each container and define it as "cntrData1"
        
                        If shpData1 = cntrData1 Then         'if there is a match between active shpData1 and current cntrData1 in the loop then...
                            Set visShape = AppVisio.ActivePage.Shapes.ItemFromID(lngShapeIDs(0)) 'get the shape ID of the active shape
        
                            visShape.Cells("pinx").ResultIU = vsoContainerShape.Cells("pinx").ResultIU 'move active shape to same horizontal position as current container in loop
                            visShape.Cells("piny").ResultIU = vsoContainerShape.Cells("piny").ResultIU 'move active shape to same vertical position as current container in loop
                            'active shape should now be centered directly on top of current container in the loop
        
                            vsoContainerShape.ContainerProperties.SetMargin visInches, 0.25
        
                            vsoContainerShape.ContainerProperties.AddMember vsoSelection, visMemberAddUseResizeSetting 'add active shape as a member of the current conatiner in the loop
        
                            ' get an enumerable list of shape ids that are already in the container
                            Dim colMembers As Collection
                            Set colMembers = getMembersOfContainer(vsoContainerShape)
        
        
                        If 0 < colMembers.Count Then 'count how many shapes in active container, required to help space out the shapes properly
                            Dim intX As Integer
                            
                            For intX = 1 To colMembers.Count
                                If colMembers.Item(intX) = visShape.ID Then
                                    Exit For
                                End If
                            Next intX
                            yoffset = (intX - 1) * 0.25
                        End If
    

                            ' put the new member near the top of the container
                            visShape.Cells("pinY").FormulaU = vsoContainerShape.Cells("PinY").Result("in") + yoffset 'yoffset determines how high up in the container the shape should be positioned
                            visShape.Cells("pinX").FormulaU = vsoContainerShape.Cells("PinX").FormulaU
        
                            vsoContainerShape.ContainerProperties.ResizeAsNeeded = visContainerAutoResizeExpandContract
                            vsoContainerShape.ContainerProperties.ResizeAsNeeded = visContainerAutoResizeExpand
        
                            ' active shape should now be positioned at the top position inside of the container
        
                            Exit For
            
                        End If
      
                    Next
        
                Exit For
            
        End If

        Exit For
                
    Next
    End If
    
Next
    
    vsoDoc1.Close 'close out the container stencils, if not the stencil will remain locked to the visio file created by this script
    
    With Application
        .DisplayAlerts = True
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    With AppVisio
        .ScreenUpdating = True
    End With
    
    AppVisio.Visible = True
    Set vsoSelection = Nothing
    Set AppVisio = Nothing
    
End Sub

    '  pass in a container and return a collection of shapeIds
    Public Function getMembersOfContainer _
                (ByRef vsoContainerShape As Visio.Shape) _
                As Collection

        On Error GoTo ErrHandler

        Dim colReturn As Collection
        Set colReturn = New Collection
        
        Dim arrMember() As Long
        arrMember = vsoContainerShape.ContainerProperties.GetMemberShapes(VisContainerFlags.visContainerFlagsDefault)
        
        Dim memberId As Long
        Dim intI As Integer

        For intI = 0 To UBound(arrMember)
            colReturn.Add (arrMember(intI))
        Next
        
        Set getMembersOfContainer = colReturn
        Exit Function
ErrHandler:
        Debug.Print "getMembersOfContainer " & Err.Description
        Set getMembersOfContainer = colReturn

    End Function

 

[Bond7042]

Hello Phil,
I am a first timer when it comes to VBA coding and I see that you have been really helpful to a lot of individuals on this gold mine of a forum. I am in need to come up with the code to generate a Visio FlowChart Diagram based off Excel Spreadsheet Data and here is how the data on the spreadsheet would look.


Header Data in Box Shape Color Arrow's Vertical Destination Diamond's Horizontal Arrow Destination


Diagram1
Screen 1 Ellipse Blue Screen 2
Screen 2 Rectangle Blue Screen 3
Screen 3 Diamond Yellow Screen 4 Screen 5
Screen 4 Rectangle Blue Screen 5


Diagram2
Screen 1 Ellipse Blue Screen 2
Screen 2 Rectangle Yellow Screen 3
Screen 3 Diamond Yellow Screen 4 Screen 5


The requirement is to get a separate flow diagram for each Header Entry.
I did try to go through the code that has been posted in this forum but I feel I am yet to gain the expertise to edit teh code to suit my needs.


I would really appreciate any help that I can receive in regards to my above request.

Regards..

 

[Bond7042]

Hi Phil,
Here is the exact represntation of Excel Data

Header	Data in Box	Shape	Color	Arrow's Vertical Destination	Diamond's Horizontal Arrow Destination
Diagram1
	Screen 1	Ellipse	Blue	Screen 2
	Screen 2	Rectangle	Blue	Screen 3
	Screen 3	Diamond	Yellow	Screen 4	Screen 5
	Screen 4	Rectangle	Blue	Screen 5
Diagram 2
	Screen 1	Ellipse	Blue	Screen 2
	Screen 2	Rectangle	Yellow	Screen 3
	Screen 3	Diamond	Yellow	Screen 4	Screen 5

<colgroup><col><col><col span="2"><col><col></colgroup><tbody>
</tbody>