Want to use macros as add-ins, but keeps adding more buttons every time I open Ppt!
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
