Custom Autoshapes

JohnWilson · #1 03-27-2012, 12:44 AM

Code:

Sub copyShape()
Dim mylibrary As Presentation
Dim osld As Slide
'open library file with NO window
Set mylibrary = Presentations.Open(Environ("USERPROFILE") & "\My Documents\CustomShapesPresentation.ppt", WithWindow:=False)
'copy shape
mylibrary.Slides(1).Shapes("CustomShape1").Copy
'paste into current slide
ActiveWindow.View.Slide.Shapes.Paste
'close library
mylibrary.Close
End Sub

Would be the basic code

If it's for client use I would hide the library file somewhere other than My Docs

excelledsoftware · #2 03-27-2012, 10:04 AM

Quote:

Originally Posted by JohnWilson

Code:

Sub copyShape()
Dim mylibrary As Presentation
Dim osld As Slide
'open library file with NO window
Set mylibrary = Presentations.Open(Environ("USERPROFILE") & "\My Documents\CustomShapesPresentation.ppt", WithWindow:=False)
'copy shape
mylibrary.Slides(1).Shapes("CustomShape1").Copy
'paste into current slide
ActiveWindow.View.Slide.Shapes.Paste
'close library
mylibrary.Close
End Sub

Would be the basic code

If it's for client use I would hide the library file somewhere other than My Docs

So helpful as always thank you.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Custom Header	mayurnk	Word	1	12-29-2010 09:35 PM
Autoshapes disappear	nsv	Word	0	09-29-2010 12:09 AM
Custom CD	rkovelman	PowerPoint	1	07-15-2010 08:50 AM
Dimension Autoshapes	karthikcoep	Word	0	01-16-2009 07:42 AM
Unable to insert AutoShapes	earthling	Word	0	01-01-2006 10:16 AM