ockins
02-16-2009, 06:30 AM
Hi Everyone,
After much troubleshooting and Googling, I stumbled upon this useful forum. I have a question regarding a PowerPoint macro that I am currently writing. I am hoping you can offer your expertise.
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 Developer forum. Since I'm unable to post links check out MSDN Microsoft Developer pages and search "Creating an Organization Chart using a List of Employees" It will be the first article in the results.
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
Attached below are the files that I am working with. The OrgChartTool file and the CSV file. Please note that the CSV file should be placed in the root directory C drive for testing purposes. Also, I am using PowerPoint 2003 to develop and test this macro. It may or may not work in PowerPoint 2007. I appreciate any and all input.
Regards,
Neal
After much troubleshooting and Googling, I stumbled upon this useful forum. I have a question regarding a PowerPoint macro that I am currently writing. I am hoping you can offer your expertise.
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 Developer forum. Since I'm unable to post links check out MSDN Microsoft Developer pages and search "Creating an Organization Chart using a List of Employees" It will be the first article in the results.
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
Attached below are the files that I am working with. The OrgChartTool file and the CSV file. Please note that the CSV file should be placed in the root directory C drive for testing purposes. Also, I am using PowerPoint 2003 to develop and test this macro. It may or may not work in PowerPoint 2007. I appreciate any and all input.
Regards,
Neal