Want to use macros as add-ins, but keeps adding more buttons every time I open Ppt!

[RachelBrooks]

Hi, I've created two macros, which work fine in my powerpoint file,. I want to make them shareable with others, so I've created them as add-ins, however my code seems to be flawed - every time I open POwerpoint, the buttons are added to the menu bar - so the first time I get the two buttons I want, then the next time I go in, I get a duplicate of each button and so on. I need to add something into my code which checks if the button is already there and if it is, ends the routine? :dunno

Here's my code:

Sub Auto_Open()

Dim NewControl As CommandBarControl

' Store an object reference to a command bar.
Dim ToolsMenu As CommandBars
'Dim MyToolBar As String

'MyToolBar = "Add Watermarking"

'On Error Resume Next

' Figure out where to place the menu choice.
Set ToolsMenu = Application.CommandBars
'If Err.Number <> 0 Then
'Exit Sub
'End If

' Create the menu choice. The choice is created in the first
' position in the Tools menu.
Set NewControl = ToolsMenu("Tools").Controls.Add _
(Type:=msoControlButton, _
Before:=1)
'If Err.Number <> 0 Then
'Exit Sub
'End If

' On Error Resume Next

' Name the command.
NewControl.Caption = "Add Watermark"

' Connect the menu choice to your macro. The OnAction property
' should be set to the name of your macro.
NewControl.OnAction = "Watermark"


' Create the menu choice. The choice is created in the first
' position in the Tools menu.
Set NewControl = ToolsMenu("Tools").Controls.Add _
(Type:=msoControlButton, _
Before:=2)
'If Err.Number <> 0 Then
' Exit Sub
'End If

' On Error GoTo ErrorHandler

' Name the command.
NewControl.Caption = "Assign Text for Watermark"

' Connect the menu choice to your macro. The OnAction property
' should be set to the name of your macro.
NewControl.OnAction = "NameShape"

'NormalExit: Exit Sub
'ErrorHandler: Exit Sub



End Sub

Sub NameShape()

Dim Name$

On Error GoTo AbortNameShape

If ActiveWindow.Selection.ShapeRange.Count = 0 Then

MsgBox "No Shapes Selected"

Exit Sub

End If



Name$ = ActiveWindow.Selection.ShapeRange(1).Name

Name$ = InputBox$("Give this shape a name", "Shape Name", Name$)

If Name$ <> "" Then

ActiveWindow.Selection.ShapeRange(1).Name = Name$

End If
Exit Sub

AbortNameShape:
MsgBox Err.Description


End Sub
Sub Watermark()
Dim strResponse As String
'Dim Sl As Slide
'Dim i As Integer

strResponse = InputBox("Enter CDSID for Watermark")

'ActivePresentation.Slides(1).Select
'ActivePresentation.Slides.Count

'With ActivePresentation.Slides.Range

'For Each Sl In ActivePresentation.Slides
'If ActivePresentation.Slides.Count >= 1 Then

'For i = 2 To ActivePresentation.Slides.Count

ActivePresentation.Slides(2).Shapes("watermark").TextFrame.TextRange.Text = strResponse
ActivePresentation.Slides(3).Shapes("watermark").TextFrame.TextRange.Text = strResponse
ActivePresentation.Slides(4).Shapes("watermark").TextFrame.TextRange.Text = strResponse
ActivePresentation.Slides(5).Shapes("watermark").TextFrame.TextRange.Text = strResponse
ActivePresentation.Slides(6).Shapes("watermark").TextFrame.TextRange.Text = strResponse
ActivePresentation.Slides(7).Shapes("watermark").TextFrame.TextRange.Text = strResponse

'Next Sl
'End With
End Sub

Sub Auto_Close()

Dim oControl As CommandBarControl
Dim ToolsMenu As CommandBars

' Get an object reference to a command bar.
Set ToolsMenu = Application.CommandBars

' Loop through the commands on the tools menu.
For Each oControl In ToolsMenu("Tools").Controls

' Check to see whether the comand exists.
If oControl.Caption = "Change to Slide Sorter" Then

' Check to see whether action setting is set to ChangeView.
If oControl.OnAction = "Watermark" Then

' Remove the command from the menu.
oControl.Delete
End If
End If
Next oControl

End Sub

[John Wilson]

Just checking is this running in 2003 or later??

There are better ways if you have 2007 on.

In 2003 this is the Auto_Close you need I think.

Sub Auto_Close()

Dim oControl As CommandBarControl
Dim ToolsMenu As CommandBars

' Get an object reference to a command bar.
Set ToolsMenu = Application.CommandBars

' Loop through the commands on the tools menu.
For Each oControl In ToolsMenu("Tools").Controls

' Check to see whether the comand exists.
If oControl.Caption = "Add Watermark" Or _
oControl.Caption = "Assign Text for Watermark" Then

' Remove the command from the menu.
oControl.Delete
End If
Next oControl

End Sub

ALSO

I would try:

On Error Resume Next
For Each Sl In ActivePresentation.Slides
Sl.Shapes("watermark").TextFrame.TextRange.Text = strResponse
Next Sl

Instead of what you had.

[RachelBrooks]

Hi John,

Thanks for the suggestions - I'm running Powerpoint 2010

Best regards
Rachel

[John Wilson]

OK you are running legacy code from 2003 and it is looking for the Tools menu which doesn't exist in 2010. It will probably still work as Microsoft built in compatibility but it's not the way!

There's a very basic tutorial on how to add XML to create ribbon entries in 2007/10 on our site here (http://www.pptalchemy.co.uk/custom_UI.html) and I have also added some XML to your code.

Download from here (http://www.pptalchemy.co.uk/Downloads/Rachel.pptm) and then save as a .ppam AddIn (not .ppa) You will see a new tab "Watermark" Make sure you SAVE to your drive as it may open in read Only mode.