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-2022, 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