DisplayName
DisplayName

Reputation: 15

Powerpoint VBA addin with multiple buttons

I've added a PowerPoint addin with one button to a toolbar in my ribbon via VBA and it works as intended. However when I try to add more than one button, the addin will only display the last button in my code. Each button appears in the toolbar and works fine if it is the only button in the code. For instance in the code below, the only button that I end up seeing is 'Button3'. Any ideas what I'm doing wrong?

Sub Auto_Open()
Dim oToolbar As CommandBar
Dim oButton As CommandBarButton
Dim MyToolbar As String

' Give the toolbar a name
MyToolbar = "Helpful Stuff"

On Error Resume Next
' so that it doesn't stop on the next line if the toolbar's already there

' Create the toolbar; PowerPoint will error if it already exists
Set oToolbar = CommandBars.Add(Name:=MyToolbar, _
    Position:=msoBarFloating, Temporary:=True)
If Err.Number <> 0 Then
      ' The toolbar's already there, so we have nothing to do
      Exit Sub
End If

On Error GoTo ErrorHandler

' Now add a button to the new toolbar
Set oButton = oToolbar.Controls.Add(Type:=msoControlButton)

' And set some of the button's properties

With oButton

     .DescriptionText = "This is my first button"
      'Tooltip text when mouse if placed over button

     .Caption = "Do Button1 Stuff"
     'Text if Text in Icon is chosen

     .OnAction = "Button1"
      'Runs the Sub Button1() code when clicked

     .Style = msoButtonIcon
      ' Button displays as icon, not text or both

     .FaceId = 52
      ' chooses icon #52 from the available Office icons

End With

' Now add a button to the new toolbar
Set oButton = oToolbar.Controls.Add(Type:=msoControlButton)

' Repeat the above for as many more buttons as you need to add
' Be sure to change the .OnAction property at least for each new button
With oButton

     .DescriptionText = "This is my second button"
      'Tooltip text when mouse if placed over button

     .Caption = "Do Button2 Stuff"
     'Text if Text in Icon is chosen

     .OnAction = "Button2"
      'Runs the Sub Button2() code when clicked

     .Style = msoButtonIcon
      ' Button displays as icon, not text or both

     .FaceId = 51
      ' chooses icon #51 from the available Office icons

End With

' Now add a button to the new toolbar
Set oButton = oToolbar.Controls.Add(Type:=msoControlButton)

With oButton

     .DescriptionText = "This is my third button"
      'Tooltip text when mouse if placed over button

     .Caption = "Do Button3 Stuff"
     'Text if Text in Icon is chosen

     .OnAction = "Button3"
      'Runs the Sub Button3() code when clicked

     .Style = msoButtonIcon
      ' Button displays as icon, not text or both

     .FaceId = 50
      ' chooses icon #50 from the available Office icons

End With

' You can set the toolbar position and visibility here if you like
' By default, it'll be visible when created. Position will be ignored in PPT 2007 and later
oToolbar.Top = 150
oToolbar.Left = 150
oToolbar.Visible = True

NormalExit:
Exit Sub   ' so it doesn't go on to run the errorhandler code

ErrorHandler:
 'Just in case there is an error
 MsgBox Err.Number & vbCrLf & Err.Description
 Resume NormalExit:
End Sub

Sub Button1()
Dim oSl As Slide
Dim oSh As Shape
Dim sFontName As String

' Edit this as needed:
sFontName = "Calibri (Body)"

With ActivePresentation
    For Each oSl In .Slides
        For Each oSh In oSl.Shapes
            With oSh
                If .HasTextFrame Then
                    If .TextFrame.HasText Then
                        .TextFrame.TextRange.Font.Name = sFontName
                    End If
                End If
            End With
        Next
    Next
End With
End Sub

Sub Button2()
' PPT coordinates are Singles rather than Doubles
Dim sngNewWidth As Single
Dim sngNewHeight As Single
Dim oSh As Shape

' Start with the height/width of first shape in selection
With ActiveWindow.Selection.ShapeRange
    sngNewWidth = .Item(1).Width
    sngNewHeight = .Item(1).Height
End With

' First find the smallest shape in the selection
For Each oSh In ActiveWindow.Selection.ShapeRange
    If oSh.Width < sngNewWidth Then
        sngNewWidth = oSh.Width
    End If
    If oSh.Height < sngNewHeight Then
        sngNewHeight = oSh.Height
    End If
Next

' now that we know the height/width of smallest shape
For Each oSh In ActiveWindow.Selection.ShapeRange
    oSh.Width = sngNewWidth
    oSh.Height = sngNewHeight
Next

End Sub
Sub Button3()
Dim w As Double
Dim h As Double
Dim obj As Shape

w = 0
h = 0

' Loop through all objects selected to assign the biggest width and height to w and h
For i = 1 To ActiveWindow.Selection.ShapeRange.Count
    Set obj = ActiveWindow.Selection.ShapeRange(i)
    If obj.Width > w Then
        w = obj.Width
    End If

    If obj.Height > h Then
        h = obj.Height
    End If
Next

' Loop through all objects selected to resize them if their height or width is smaller than h/w
For i = 1 To ActiveWindow.Selection.ShapeRange.Count
    Set obj = ActiveWindow.Selection.ShapeRange(i)
    If obj.Width < w Then
        obj.Width = w
    End If

    If obj.Height < h Then
        obj.Height = h
    End If
Next
End Sub

Upvotes: 1

Views: 1019

Answers (1)

David Zemens
David Zemens

Reputation: 53663

It seems likely what happened during your debugging is that you've added some instance of the AddIn toolbar, and now it exists in that state. So, you need to ensure that you always remove it before attempting to add it.

With some other minor re-factoring, I would recommend like so:

Option Explicit

' Give the toolbar a name
Const MyToolbar As String = "Helpful Stuff"
Dim oToolbar As CommandBar

Sub Auto_Open()

Dim oButton As CommandBarButton

Call AddMe

On Error GoTo ErrorHandler

' Now add a button to the new toolbar
Set oButton = oToolbar.Controls.Add(Type:=msoControlButton)

' And set some of the button's properties

With oButton
     .DescriptionText = "This is my first button"      'Tooltip text when mouse if placed over button
     .Caption = "Do Button1 Stuff"      'Text if Text in Icon is chosen
     .OnAction = "Button1"       'Runs the Sub Button1() code when clicked
     .Style = msoButtonIcon      ' Button displays as icon, not text or both
     .FaceId = 52      ' chooses icon #52 from the available Office icons
End With

' Now add a button to the new toolbar
Set oButton = oToolbar.Controls.Add(Type:=msoControlButton)

' Repeat the above for as many more buttons as you need to add
' Be sure to change the .OnAction property at least for each new button
With oButton
     .DescriptionText = "This is my second button"      'Tooltip text when mouse if placed over button
     .Caption = "Do Button2 Stuff"     'Text if Text in Icon is chosen
     .OnAction = "Button2"      'Runs the Sub Button2() code when clicked
     .Style = msoButtonIcon      ' Button displays as icon, not text or both
     .FaceId = 51      ' chooses icon #51 from the available Office icons
End With

' Now add a button to the new toolbar
Set oButton = oToolbar.Controls.Add(Type:=msoControlButton)
With oButton
     .DescriptionText = "This is my third button"      'Tooltip text when mouse if placed over button
     .Caption = "Do Button3 Stuff"     'Text if Text in Icon is chosen
     .OnAction = "Button3"      'Runs the Sub Button3() code when clicked
     .Style = msoButtonIcon      ' Button displays as icon, not text or both
     .FaceId = 50      ' chooses icon #50 from the available Office icons
End With

NormalExit:
Exit Sub   ' so it doesn't go on to run the errorhandler code

ErrorHandler:
 'Just in case there is an error
 MsgBox Err.Number & vbCrLf & Err.Description
 Resume NormalExit:
End Sub

You'll need to add these two procedures:

Private Sub RemoveMe()
' Removes the toobar if it already exists:
    On Error Resume Next
    CommandBars(MyToolbar).Delete
End Sub

Private Sub AddMe()
    ' If the toolbar already exists, remove it
    Call RemoveMe

    Set oToolbar = CommandBars.Add(Name:=MyToolbar, _
        Position:=msoBarFloating, Temporary:=True)

    ' You can set the toolbar position and visibility here if you like
    ' By default, it'll be visible when created. Position will be ignored in PPT 2007 and later
    oToolbar.Top = 150
    oToolbar.Left = 150
    oToolbar.Visible = True
End Sub

Upvotes: 1

Related Questions