# PowerPoint VBA Macro - Organization Diagram Macro Not Looping Correctly



## ockins (Feb 10, 2009)

Hello Everyone,

I have searched this board many times for programming VBA Macros in Excel and it has been very helpful.  I am working with a macro in PowerPoint, so I was hoping I may be able to tap your knowledge.  If this is inappropriate and not "Excel focused" I will remove this question.

Anyway,  I have been working on a Macro for PowerPoint that would enable me to print an Organizational Chart from a CSV file that is exported from an Excel Business Planning spreadsheet.  This macro was designed based upon information in the MSDN forum, available here: http://msdn.microsoft.com/en-us/library/aa140203(office.10).aspx

Basically, the macro is able to retrieve all of the data from the CSV file, place it into a recordset and begin filtering and writing Organizational Chart pieces to the PowerPoint slide, but it is not reiterating through the entire global record set.  Using my debug code, I am seeing that it is checking for existing nodes, but not identifying and properly filtering beyond the second level of data in the CSV file.  How can I solve this issue so the macro iterates through all data?  Any help or insight that you can provide would be appreciated.

The data in the CSV file looks like that below:

```
Name,Title,EmpOrg,SuperiorOrg
John CEO,President,Business Residence,Corporate Entity
Betty Sales,sales,sales,Business Residence
Steve FIN,finance,finance,Business Residence
Polly HR,HR,HR,finance
Molly CONS,Consulting,Consulting,Business Residence
Peter CONS,Consulting,Consulting,Consulting
```
I know that including the whole macro is frowned upon, but due to the modularity of the macro, I will include as much as I can, sans the debug code.  If you would like further assistance I can forward that code to you or email you the entire PPT and CSV file that I'm working with.


```
Option Explicit

'Need to set a reference to the Microsoft ActiveX Data Objects 2.5 Library
Dim grstMain As ADODB.Recordset

'New Values needed for DB connection
Public cn As ADODB.Connection

'Global enumeration for the node type used in AddNewNode function
Public Enum NodeTypeEnum
    Parent = 1
    Assistant = 2
    Child = 3

End Enum

'To run the following code use one of the test procedures below:
Sub CreateOrgChartInPowerPoint()
    Call CreateOrgChart(objDocument:=ActivePresentation.Slides(1), _
        strPath:=ActivePresentation.Path)
End Sub

'Sub CreateOrgChartInWord()
'    Call CreateOrgChart(objDocument:=ActiveDocument, _
'       strPath:=ActiveDocument.Path & "\employees.mdb", strTable:="EmpNames")
'End Sub

Sub CreateOrgChart(ByRef objDocument As Object, ByRef strPath As String)
    
    Dim blnHaveRST As Boolean
    Dim rstReports As ADODB.Recordset
    Dim shpOrgChart As Shape
    Dim dgnFirstNode As DiagramNode
    Dim strActiveConnection As String
    
    Const NAME_FIELD = "Name"
    Const BOSS_FIELD = "SuperiorOrg"
    Const TITLE_FIELD = "Title"
    Const PROPS_FIELD = "EmpOrg"
    Const TITLE_FIRST_NODE = "Corporate Entity"
    Const DIAGRAM_POSITION_LEFT = 0
    Const DIAGRAM_POSITION_TOP = 0
    Const DIAGRAM_SIZE_WIDTH = 720
    Const DIAGRAM_SIZE_HEIGHT = 540

    'Modified Version for Testing
    strActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\;" _
    & "Extended Properties=""text;HDR=Yes;FMT=Delimited"";"


    'Get main recordset
    blnHaveRST = GetData(strActiveConnection:=strActiveConnection, _
        strCursorType:=adOpenStatic)
    
    If blnHaveRST = True Then
        'Create base organizational chart diagram
        Set shpOrgChart = CreateDiagram(objDocument:=objDocument, DiagramType:=msoDiagramOrgChart, _
            intPositionLeft:=DIAGRAM_POSITION_LEFT, intPositionTop:=DIAGRAM_POSITION_TOP, _
            intSizeWidth:=DIAGRAM_SIZE_WIDTH, intSizeHeight:=DIAGRAM_SIZE_HEIGHT)
    
        'Create main parent node
        Set rstReports = GetReports(strField:=BOSS_FIELD, strFilter:=TITLE_FIRST_NODE)
        Set dgnFirstNode = AddNewNode(rstTemp:=rstReports, shpDiagram:=shpOrgChart, _
            strNameField:=NAME_FIELD, strTitleField:=TITLE_FIELD, strPropsField:=PROPS_FIELD, eNodeType:=Parent)
        
        
        'Add nodes for employees
        Set rstReports = GetReports(strField:=BOSS_FIELD, strFilter:=rstReports.Fields(PROPS_FIELD).Value)


        If rstReports.RecordCount > 0 Then
            AddNodes rstReports:=rstReports, dgnParentNode:=dgnFirstNode, _
                strNameField:=NAME_FIELD, strManagerField:=BOSS_FIELD, _
                strTitleField:=TITLE_FIELD, strPropsField:=PROPS_FIELD
                                
        End If
        
        rstReports.Close
        Set rstReports = Nothing
        
        grstMain.Close
        Set grstMain = Nothing
    
    End If
    
End Sub

Function GetData(ByVal strActiveConnection As String, _
            ByVal strCursorType As CursorTypeEnum) As Boolean
    
    Dim rstTemp As New ADODB.Recordset
    Dim strsql As String
    
    'Define SQL query to select data from CSV
    strsql = "SELECT * from OrgBP_Data_Export_Clean2.csv"
    'strsql = "SELECT * from EmpNames.csv"
    
    'Create DB Connection - Revised Method
    Set cn = CreateObject("ADODB.Connection")
    cn.Open strActiveConnection
    
    cn.CursorLocation = adUseServer
    Set rstTemp.ActiveConnection = cn
    rstTemp.CursorType = adOpenStatic
    
    'Open recordset, adding data to SQL query
    rstTemp.Open strsql
    
    'ClonerstTemp to grstMain
    Set grstMain = rstTemp
    
    On Error GoTo Error_Handler
    GetData = True
Exit_Sub:
   Exit Function
Error_Handler:
    Select Case Err.Number
        Case -2147467259
            MsgBox "You must first save your document."
        Case Else
            MsgBox "An unknown error occurred."
    End Select

    GetData = False
    
End Function

Function GetReports(ByVal strField As String, ByVal strFilter As String) _
        As ADODB.Recordset
    Dim rstTemp As New ADODB.Recordset
    'Create a clone of the main global recordset
    Set rstTemp = grstMain.Clone
    rstTemp.Filter = strField & " = '" & strFilter & "'"
    Set GetReports = rstTemp
End Function

Function CreateDiagram(ByVal objDocument As Object, _
    ByVal DiagramType As MsoDiagramType, ByVal intPositionLeft As Integer, _
    ByVal intPositionTop As Integer, ByVal intSizeWidth As Integer, _
    intSizeHeight As Integer) As Shape
    'You can use this function for Word, PowerPoint, and Excel. Just pass in a
    'Document (Word), Slide (PowerPoint), or Worksheet (Excel) object as objDocument.

    Set CreateDiagram = objDocument.Shapes.AddDiagram _
        (Type:=DiagramType, Left:=intPositionLeft, Top:=intPositionTop, _
        Width:=intSizeWidth, Height:=intSizeHeight)

End Function

Function AddNewNode(ByVal rstTemp As ADODB.Recordset, ByVal strNameField As String, _
        ByVal strTitleField As String, ByVal strPropsField As String, ByVal eNodeType As NodeTypeEnum, _
        Optional ByVal NodeLayout As MsoOrgChartLayoutType, Optional ByVal shpDiagram As Shape, _
        Optional ByVal dgnParentNode As DiagramNode) As DiagramNode

    Dim dgnNewNode As DiagramNode
    On Error Resume Next
    'Create new node
    Select Case eNodeType
        
        Case Parent
            Set dgnNewNode = shpDiagram.DiagramNode.Children.AddNode

        Case Assistant
            Set dgnNewNode = dgnParentNode.Children.AddNode(NodeType:=msoDiagramAssistant)

        Case Child
            Set dgnNewNode = dgnParentNode.Children.AddNode
            dgnNewNode.Layout = NodeLayout    
    End Select

    'Add name and title to node
    With dgnNewNode.TextShape.TextFrame

        .WordWrap = False
        Call AddFormatText(objText:=.TextRange, _
            strName:=rstTemp.Fields(strNameField).Value, _
            strTitle:=rstTemp.Fields(strTitleField).Value, strProps:=rstTemp.Fields(strPropsField))
    End With
    Set AddNewNode = dgnNewNode
End Function

Sub AddNodes(ByVal rstReports As ADODB.Recordset, ByRef dgnParentNode As DiagramNode, _
        strNameField As String, strManagerField As String, strTitleField As String, strPropsField As String)

    Dim dgnNode As DiagramNode
    Dim rstTemp As ADODB.Recordset

    Do While Not rstReports.EOF
        
        'Create assistant node
        If InStr(1, rstReports.Fields(strTitleField).Value, "Assistant") Then
            Set dgnNode = AddNewNode(rstTemp:=rstReports, _
                strNameField:=strNameField, strTitleField:=strTitleField, strPropsField:=strPropsField, _
                eNodeType:=Assistant, dgnParentNode:=dgnParentNode)

        'Create all other nodes
        Else
            Set dgnNode = AddNewNode(rstTemp:=rstReports, _
                strNameField:=strNameField, strTitleField:=strTitleField, strPropsField:=strPropsField, _
                dgnParentNode:=dgnParentNode, eNodeType:=Child, _
                NodeLayout:=msoOrgChartLayoutRightHanging)

            'Get any direct reports for node added above
            Set rstTemp = GetReports(strManagerField, rstReports.Fields(strNameField).Value)
            If rstTemp.RecordCount > 0 Then
                Do While Not rstTemp.EOF
                    'Recurse through the AddNodes routine for direct reports
                    Call AddNodes(rstReports:=rstTemp, dgnParentNode:=dgnNode, _
                        strNameField:=strNameField, strManagerField:=strManagerField, _
                        strTitleField:=strTitleField, strPropsField:=strPropsField)
                Loop
                rstTemp.Close
                Set rstTemp = Nothing
            End If
        End If
        rstReports.MoveNext
    Loop
End Sub

Sub AddFormatText(ByRef objText As Object, ByVal strName As String, _
    ByVal strTitle As String, ByVal strProps As String)

    With objText
        .Text = strName & vbCrLf & strTitle & vbCrLf & strProps
        .Font.Size = 8
    End With
End Sub
```
Regards,
Neal


----------



## VoG (Feb 10, 2009)

Hello and welcome to MrExcel.

I'm going to disregard the forum rules and suggest that you post here http://www.theofficeexperts.com/forum/forumdisplay.php?f=6 but please provide a link back.


----------



## Smitty (Feb 10, 2009)

VoG said:


> I'm going to disregard the forum rules and suggest that you post here http://www.theofficeexperts.com/forum/forumdisplay.php?f=6 but please provide a link back.



There's no problem referring someone to TOE for questions that wouldn't be standard here.


----------



## ockins (Feb 11, 2009)

Thanks for the tip on TOE.  I was searching for other PowerPoint based forums, but this one seems like a good resource.

I posted my message over there, so hopefully they can offer some insight.
http://www.theofficeexperts.com/forum/showthread.php?p=36000#post36000

Thanks for your help.


----------

