Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 03-25-2012, 12:17 PM
excelledsoftware excelledsoftware is offline Custom Autoshapes Windows 7 64bit Custom Autoshapes Office 2003
IT Specialist
Custom Autoshapes
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default Custom Autoshapes


I researched this awhile ago and never really figured out if it is possible. Does anyone know if there is anyway to make a shape with the freeform tool and then save it somehow to be a future autoshape that you can use. I'm sure you would have to export the drawn autoshape as a metafile or something then convert it and place it into the office11 folder located in the programs folder.
Reply With Quote
  #2  
Old 03-26-2012, 03:26 AM
JohnWilson JohnWilson is offline Custom Autoshapes Windows 7 64bit Custom Autoshapes Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,912
JohnWilson has a spectacular aura aboutJohnWilson has a spectacular aura about
Default

I don't think that's possible.

We usually have such things in a library presentation and then have code to open it invisibly , copy and paste the correct shape into the current slide.

If the shape is simple it MIGHT be possible to recreate the shape using the FreeformBuilder method but the math is not simple for anything more than a very simple shape
__________________
Microsoft PowerPoint MVP 2007-2023
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote
  #3  
Old 03-26-2012, 04:49 AM
excelledsoftware excelledsoftware is offline Custom Autoshapes Windows 7 64bit Custom Autoshapes Office 2003
IT Specialist
Custom Autoshapes
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

Quote:
Originally Posted by JohnWilson View Post
I don't think that's possible.

We usually have such things in a library presentation and then have code to open it invisibly , copy and paste the correct shape into the current slide.

If the shape is simple it MIGHT be possible to recreate the shape using the FreeformBuilder method but the math is not simple for anything more than a very simple shape
I see well if I wanted to do lets say an hourglass with rounded edges that I have created in freeform how would I get that into the library and then execute code for it? or would that be too complex of a shape?
Reply With Quote
  #4  
Old 03-26-2012, 10:38 AM
JohnWilson JohnWilson is offline Custom Autoshapes Windows 7 64bit Custom Autoshapes Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,912
JohnWilson has a spectacular aura aboutJohnWilson has a spectacular aura about
Default

I was really suggesting you stored the actual shapes in a presentation and wrote code to open it invisibly (WithWindow:=false) and then copy in code and paste ito the presentation in code. The effect is much like the normal Insert Shape method.

You can read up on the FreeformBuilder method but it is pretty complex.
__________________
Microsoft PowerPoint MVP 2007-2023
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote
  #5  
Old 03-26-2012, 11:05 PM
excelledsoftware excelledsoftware is offline Custom Autoshapes Windows 7 64bit Custom Autoshapes Office 2003
IT Specialist
Custom Autoshapes
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

Quote:
Originally Posted by JohnWilson View Post
I was really suggesting you stored the actual shapes in a presentation and wrote code to open it invisibly (WithWindow:=false) and then copy in code and paste ito the presentation in code. The effect is much like the normal Insert Shape method.

You can read up on the FreeformBuilder method but it is pretty complex.
Oh ok so let me see if I understand.
In a presentation I would create the shapes then probably name them something unique. Then write code in my working presentation that would paste this created/named shape into my current presentation without the shape presentation being open.

If that is right can you give me a basic code? for example I would call the shape CustomShape1 in a presentation called CustomShapesPresentation located in the my documents folder.

Thanks
Reply With Quote
  #6  
Old 03-27-2012, 12:44 AM
JohnWilson JohnWilson is offline Custom Autoshapes Windows 7 64bit Custom Autoshapes Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,912
JohnWilson has a spectacular aura aboutJohnWilson has a spectacular aura about
Default

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
__________________
Microsoft PowerPoint MVP 2007-2023
Free Advanced PowerPoint Tips and Tutorials

Last edited by JohnWilson; 03-27-2012 at 02:54 AM.
Reply With Quote
  #7  
Old 03-27-2012, 10:04 AM
excelledsoftware excelledsoftware is offline Custom Autoshapes Windows 7 64bit Custom Autoshapes Office 2003
IT Specialist
Custom Autoshapes
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

Quote:
Originally Posted by JohnWilson View Post
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.
Reply With Quote
  #8  
Old 03-27-2012, 10:12 AM
excelledsoftware excelledsoftware is offline Custom Autoshapes Windows 7 64bit Custom Autoshapes Office 2003
IT Specialist
Custom Autoshapes
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

Here is the final result. I love adding an inputbox to give the ability to choose different shapes. Thanks again John
Sub copyShape()
Dim mylibrary As Presentation
Dim osld As Slide
Dim shapebox As String
shapebox = InputBox("type in the shape name")
'open library file with NO window
Set mylibrary = Presentations.Open(Environ("USERPROFILE") & "\My Documents\CustomShapesPresentation.ppt", WithWindow:=False)
'copy shape
mylibrary.Slides(1).Shapes(shapebox).Copy
'paste into current slide
ActiveWindow.View.Slide.Shapes.Paste
'close library
mylibrary.Close
End Sub
Reply With Quote
  #9  
Old 06-03-2012, 09:04 AM
excelledsoftware excelledsoftware is offline Custom Autoshapes Windows 7 64bit Custom Autoshapes Office 2003
IT Specialist
Custom Autoshapes
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

Sorry to reactivate this thread but is there a way to do this same thing but by using a drop box to select the shape I want (Drop box would need to just be text)?
Reply With Quote
  #10  
Old 06-04-2012, 01:27 AM
JohnWilson JohnWilson is offline Custom Autoshapes Windows 7 64bit Custom Autoshapes Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,912
JohnWilson has a spectacular aura aboutJohnWilson has a spectacular aura about
Default

You can only do this if you save all the code as ppa addin. (Otherwise the auto_run won't work)

You need to build a menu and use it to send the shape name. You'll need to work on this but it would look like:


Code:
Public Const ADDIN_NAME As String = "the name goes here"

Sub Auto_Open()
    
    Dim myMainMenuBar As CommandBar
    Dim myCustomMenu As CommandBarControl
    Dim myTempMenu As CommandBarControl
    
    On Error Resume Next
    'kill any old menu
    Application.CommandBars.ActiveMenuBar.Controls(ADDIN_NAME).Delete
    Set myMainMenuBar = Application.CommandBars.ActiveMenuBar
    Set myCustomMenu = myMainMenuBar.Controls.Add(Type:=msoControlPopup, _
                      before:=3) 'new menu before the third existing menu
    myCustomMenu.Caption = ADDIN_NAME
    
'************************
    Set myTempMenu = myCustomMenu.Controls.Add(Type:=msoControlButton)
    With myTempMenu
                .Caption = "Whatever"
                .OnAction = "name_of_macro"
    End With
'*************************
    Set myTempMenu = myCustomMenu.Controls.Add(Type:=msoControlButton)
    With myTempMenu
                .Caption = "Whatever2"
                .OnAction = "name_of_macro2"
    End With
'*************************
'Add more blocks for more menu items
    
    End Sub

Sub name_of_macro()
Call insertshape("circle") 'obviously use your names
End Sub
Sub name_of_macro2()
Call insertshape("square")
End Sub
Sub copyShape(shapebox As String)
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(shapebox).Copy
'paste into current slide
ActiveWindow.View.Slide.Shapes.Paste
'close library
mylibrary.Close
End Sub
__________________
Microsoft PowerPoint MVP 2007-2023
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Custom Autoshapes Custom Header mayurnk Word 1 12-29-2010 09:35 PM
Autoshapes disappear nsv Word 0 09-29-2010 12:09 AM
Custom Autoshapes 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

Other Forums: Access Forums

All times are GMT -7. The time now is 10:31 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft