Org chart depth limited to 46 shapes

Guessed · #10 11-09-2019, 02:28 AM

OK, perhaps you might want to show me the code you are using. It shouldn't be difficult to change shape masters. For instance, in this code extract the choice of shape master is on one line.

Code:

  With appVisio
    If .Documents.Count > 0 And Not bNewDoc Then
      Set aDoc = .ActiveDocument
      Set aPage = aDoc.Pages.Add
    Else
      Set aDoc = .Documents.Add(Filename:=sTemplatePath & sVisioTemplate)
      Set aPage = .ActivePage
    End If
    Set aDocStencil = GetDocStencil(appVisio, sStencil, sStencilPath)      'Load Stencil
    
    'Clear page for new shapes to be added
    Do While aPage.Shapes.Count > 0
      aPage.Shapes(1).Delete
    Loop
    aPage.AutoSize = False
    Set aMast = aDocStencil.Masters(sMaster)
    On Error Resume Next
    For Each aRow In loWBS.DataBodyRange.SpecialCells(xlCellTypeVisible).Rows
      Debug.Print Trim(aRow.Cells(1).Value)
      lRow = lRow + 1
      lLeftStep = aRow.Cells(3).Value
      If lRow > 1 Then sParent = Trim(aRow.Cells(4).Value)
      If bJoin And sParent <> "" Then
        Set aShp = aPage.DropConnected(aMast, aPage.Shapes("WBS_" & sParent), 2)    'visAutoConnectDirDown=2
      Else
        lPosY = lPosY - lPrevShapeHeight - dblSpacing
        Set aShp = aPage.Drop(aMast, 1 + lLeftStep / 2, lPosY)    ' 10 - lRow / 3
        lPrevShapeHeight = aShp.CellsU("Height")
      End If
      aShp.Name = "WBS_" & Trim(aRow.Cells(1).Value)
      For i = LBound(arrProps) To UBound(arrProps)
        sProp = "Prop." & arrProps(i)
        aShp.CellsU(sProp).FormulaU = Chr(34) & Trim(aRow.Cells(i + 1).Value) & Chr(34)
      Next
    Next aRow

This code extract is more complicated than necessary because it includes an option to link child graphics or place them in an indented tree structure without a link depending on a choice the user made earlier.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
VBA to add shapes to Smart Art Org Chart	R Mohan	PowerPoint	4	06-18-2018 12:43 PM
PPT 2010 - Animated Chart by Series - Animations reset when editing chart	agaudet21	PowerPoint	0	10-12-2017 06:18 AM
Powerpoint \| animation \| depth management	aGrumpyKoala	PowerPoint	3	08-19-2016 05:43 AM
MS Project 2013 Reports: ACWP in Timephased Line Chart does not match ACWP in Column Chart or Table	billcary	Project	3	09-22-2014 07:10 AM
Field Size Limited to 255	RzB	Mail Merge	1	11-30-2011 04:51 AM