Insert custom SmartArt programmatically

OfficeTips Home || VBA Section || General Section || Download Section || Privacy Policy

Insert custom smartart programmatically

If you have download additionaly smartarts from Office.com or other sources and wondering how to insert them programmatically into your deck then it is not too difficult.

First double-check that the custom GLOX file is located in the %appdata%\Microsoft\Templates\SmartArt Graphics folder. This ensures that the smartart appears in the PowerPoint UI as well as in the smartart layout collection in the object model. The example below retrieves my custom smartart - Dotted List and inserts it into the slide.

Supported versions: PowerPoint 2010+

' --------------------------------------------------------------------------------
' Copyright ©1999-2018, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or 
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' -------------------------------------------------------------------------------

Sub InsertCustomSmartArt()
Dim oSlide As Slide
Dim oSmartArtLayout As SmartArtLayout
Dim oSmartArt As SmartArt

Set oSlide = ActivePresentation.Slides(1)
Set oSmartArtLayout = GetLayoutByName("List Dots")

If Not oSmartArtLayout Is Nothing Then
    Set oSmartArt = oSlide.Shapes.AddSmartArt(oSmartArtLayout).SmartArt        
    'Manipulate the SmartArt
    oSmartArt.Nodes(1).TextFrame2.TextRange = "Sample"
Else
    MsgBox "Could you locate the Smart Art layout", vbExclamation
End If
End Sub
Function GetLayoutByName(SmartArtName As String) As SmartArtLayout
Dim I As Long

For I = 1 To Application.SmartArtLayouts.Count
    If LCase(Application.SmartArtLayouts(I).Name) = LCase(SmartArtName) Then
        Set GetLayoutByName = Application.SmartArtLayouts(I)
        Exit Function
    End If
Next
End Function