Organization chart with VBA

[Worf]

Worf submitted a new Excel article:

Organization chart with VBA - This post shows how to create an organogram with VBA.

• Smart art can create organization charts, but it will have formatting limitations; the code below overcomes that.
• Prepare a source table containing the following information:
  • Columns A and B – the relationships between two elements. The shape fill color will come from column A.
  • Column C – descriptive text to be displayed.
  • Column D – auxiliary data to be placed next to the shape.
  • Column E – whether the shape has an outline or not.

• Now...

Read more about this Excel article...

 

[flipsidelive]

This looks brilliant but I'm struggling to get it working. I get to this line, 'CommandBars.ExecuteMso ("SmartArtConvertToShapes")' and I get 'Object Variable not set. I'm on the latest version of office. Can anyone help?

 

[Worf]

I will analyze it as soon as possible...

 

[Worf]

What do you get when running this?

Sub test()
MsgBox Val(Application.Version)
End Sub

 

[flipsidelive]

Hi. It says 16

 

[Worf]

Please run this other one, do you get an organizational chart?

Sub another_test()
Dim oshp
Set oshp = ActiveSheet.Shapes.AddSmartArt(Application.SmartArtLayouts _
("urn:microsoft.com/office/officeart/2008/layout/NameandTitleOrganizationalChart"))
End Sub

 

[zach2025]

Hey Worf,
I am also trying to get this Org Chart to work. I am on Excel 2016, and running the test above gives me an Org Chart with simplified text. However I think I am missing some key information about how to run the Module. Such as:

Does the primary data go in a sheet named tdata?
What goes in the sheet secdata?
What goes in sheet fshap?

Even taking your test data above, and putting it into tdata, or in tdata and secdata, comes up with an error.

If it is any help I get a type mismatch error on the following line:
"arr = Range([a1].CurrentRegion.Address) "

 

[zach2025]

Got it to work once, when I put the data in fshap like you had in the example, but now it isn't working. I keep having an error:

Run-time error '-2147024809 (80070057)':
The item with the specified name wasn't found.

Upon debug this error corresponds to:
ws.Shapes(Range("a" & i) & "aux").Top = sn.Top + sn.Height

 

[zach2025]

Please run this other one, do you get an organizational chart?

Sub another_test()
Dim oshp
Set oshp = ActiveSheet.Shapes.AddSmartArt(Application.SmartArtLayouts _
("urn:microsoft.com/office/officeart/2008/layout/NameandTitleOrganizationalChart"))
End Sub

Got this to work, and I got the code to work once, but now it isn't working. Any advice? Running 16, and this code works as well.

 

[Worf]

Were you able to proceed? you can also try post #33 from the thread below.

VBA to create organisation chart

Hi there, I found a great macro on the web that nearly does my job. But only nearly. Unfortunately this code is really high level, and I have no idea how to solve it. Super challenging! You can download the file here: orgaproblem And what I would like to achieve is below: (see picture) Note...

www.mrexcel.com