Microsoft Office Forums - View Single Post

excelledsoftware · 08-30-2014, 03:27 PM

This is not the exact solution but it may be able to work if you do not want to hire someone.
The code below John Wilson helped me with. Basically you set up all your autoshapes in a presenation and then type the name of the shape to make it appear in your current presentation. I use it all the time.

Code:

Sub customShape()
  Dim mylibrary As Presentation, osld As Slide, shapebox As String

    shapebox = InputBox("type in the shape name")
    'open library file with NO window
    Set mylibrary = Presentations.Open(Environ("USERPROFILE") &  _ 
     "\My Documents\CustomShapes.ppt", WithWindow:=False) 'make to wherever your shapes are.
    'copy shape
    mylibrary.Slides(1).Shapes(shapebox).Copy
    'paste into current slide
    ActiveWindow.View.Slide.Shapes.Paste
    'close library
    mylibrary.Close
End Sub

I also have another code that will give me a list of all the shapes in my library so in case I forget the name I can look at the possibilities.

Code:

Sub shapelist()
  Dim curlibrary As Presentation, oshp As Shape, AllShapeMsg As String, curosld As Slide
  
    Set curlibrary = Presentations.Open(Environ("USERPROFILE") & _
     "\My Documents\CustomShapes.ppt", WithWindow:=False)
    Set curosld = curlibrary.Slides(1)
    For Each oshp In curosld.Shapes
      AllShapeMsg = AllShapeMsg & oshp.Name & vbCrLf
    Next oshp
    curlibrary.Close
    MsgBox AllShapeMsg

End Sub

Not a perfect solution but FREE!!!

ps sorry for the long lines I was really new to coding back when I wrote this.