Microsoft Office Forums - View Single Post

JohnWilson · 06-04-2012, 01:27 AM

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