Solved

How to place images on toolbar macro buttons using VBA

Posted on 2009-05-08
12
919 Views
Last Modified: 2012-06-21
 I am building a toolbar of buttons to activate macros to change colors on a selected object in PPT 2003.

The code below works ok but the buttons created have text on them.  I would like to replace the text with an image of the actual color that will be applied.

I will create the button images, any suggestions on how to create these would be appreciated.

Any help appreciated.

Thanks
Ken

Thanks

Ken


With oButton2

         .DescriptionText = "blue"

          'Tooltip text when mouse if placed over button

         .Caption = "blue kpc"

         'Text if Text in Icon is chosen

         .OnAction = "Button2"

          'Runs the Sub Button1() code when clicked

         .Style = msoButtonIcon

          ' Button displays as icon, not text or both

         .FaceId = 52

          '52 is my favorite pig;

          ' chooses icon #52 from the available Office icons

    End With

Open in new window

0
Comment
Question by:Ken_Chandler
  • 6
  • 5
12 Comments
 
LVL 4

Expert Comment

by:r0bertdenir0
ID: 24342884
Create the images in any editor - Windows Paint is simple & readily available.
 
 To apply it to a command bar button, you need to copy it to the clipboard, then use the PasteFace method of the respective CommandBarButton object
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24344373
Ken_Chandler,

Replace the path to the graphic as befits your graphic:

    Set picPicture = stdole.StdFunctions.LoadPicture("C:\DELL\E-Center\images\finish_button_en.gif")

Chris
    Set picPicture = stdole.StdFunctions.LoadPicture("C:\DELL\E-Center\images\finish_button_en.gif")

With oButton2

         .DescriptionText = "blue"

          'Tooltip text when mouse if placed over button

         .Caption = "blue kpc"

         'Text if Text in Icon is chosen

         .OnAction = "Button2"

          'Runs the Sub Button1() code when clicked

        .Style = msoButtonIconAndCaption

        .Picture = picPicture

End With

Open in new window

0
 

Author Comment

by:Ken_Chandler
ID: 24346134
Hi Chris,

Thank you for this, I will give it a try and let you know how I get on.

Regards

Ken
0
 

Author Comment

by:Ken_Chandler
ID: 24346980
Hi
as you have probably guessed VBA is not my strong point.  I have tried your suggestion and I get a compile error.

I have attached the complete module.  Could I ask someone to have a look at it and see where I have gone wrong?  I do not think the     Set picPicture = is done correctly.

Also while checking it out can you see any reason why the toolbar will not load automatically when the template is activated?


Many thanks

Ken
Option Explicit
 

Sub Auto_Open()

    Dim oToolbar As CommandBar

    Dim oButton1 As CommandBarButton

     Dim oButton2 As CommandBarButton

    Dim MyToolbar As String
 

    ' Give the toolbar a name

    MyToolbar = "Shape colours"
 

    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 oButton1 = oToolbar.Controls.Add(Type:=msoControlButton)

    Set oButton2 = oToolbar.Controls.Add(Type:=msoControlButton)
 

    ' And set some of the button's properties

    

   

     Set picPicture = stdole.StdFunctions.LoadPicture("C:\images\blue.gif")
 

With oButton1

         .DescriptionText = "Blue"

          'Tooltip text when mouse if placed over button

         .Caption = "blue fill"

         'Text if Text in Icon is chosen

         .OnAction = "Button1"

          'Runs the Sub Button1() code when clicked

        .Style = msoButtonIconAndCaption

        .Picture = picPicture

End With
 

  

 End With
 

      With oButton2

         .DescriptionText = "Dark Green"

          'Tooltip text when mouse if placed over button

         .Caption = "Dark Green"

         'Text if Text in Icon is chosen

        ' .OnAction = "Button2"

          'Runs the Sub Button1() code when clicked

        ' .Style = msoButtonCaption

          ' Button displays as icon, not text or both

 '        .FaceId = 52

          '52 is my favorite pig;

          ' chooses icon #52 from the available Office icons

    End With
 

    ' 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
 

    ' You can set the toolbar position and visibility here if you like

    ' By default, it'll be visible when created

    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()

' This code will run when you click Button 1 added above

' Add a similar subroutine for each additional button you create on the toolbar

    ' This is just some silly example code.

    ' You'd put your real working code here to do whatever

    ' it is that you want to do

     With ActiveWindow.Selection.ShapeRange

        .Fill.ForeColor.RGB = RGB(255, 203, 5)

    End With

End Sub
 

Sub Button2()

' This code will run when you click Button 2 added above

' Add a similar subroutine for each additional button you create on the toolbar

    ' This is just some silly example code.

    ' You'd put your real working code here to do whatever

    ' it is that you want to do

     With ActiveWindow.Selection.ShapeRange

        .Fill.ForeColor.RGB = RGB(0, 114, 63)

    End With

End Sub

Open in new window

0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24346991
Apologies ... the variable needs to be defined:

    Dim picPicture As IPictureDisp

Chris
Option Explicit

 

Sub Auto_Open()

    Dim oToolbar As CommandBar

    Dim oButton1 As CommandBarButton

     Dim oButton2 As CommandBarButton

    Dim MyToolbar As String

   Dim picPicture As IPictureDisp

 

    ' Give the toolbar a name

    MyToolbar = "Shape colours"

 

    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 oButton1 = oToolbar.Controls.Add(Type:=msoControlButton)

    Set oButton2 = oToolbar.Controls.Add(Type:=msoControlButton)

 

    ' And set some of the button's properties

    

   

     Set picPicture = stdole.StdFunctions.LoadPicture("C:\images\blue.gif")

 

With oButton1

         .DescriptionText = "Blue"

          'Tooltip text when mouse if placed over button

         .Caption = "blue fill"

         'Text if Text in Icon is chosen

         .OnAction = "Button1"

          'Runs the Sub Button1() code when clicked

        .Style = msoButtonIconAndCaption

        .Picture = picPicture

End With

 

  

 End With

 

      With oButton2

         .DescriptionText = "Dark Green"

          'Tooltip text when mouse if placed over button

         .Caption = "Dark Green"

         'Text if Text in Icon is chosen

        ' .OnAction = "Button2"

          'Runs the Sub Button1() code when clicked

        ' .Style = msoButtonCaption

          ' Button displays as icon, not text or both

 '        .FaceId = 52

          '52 is my favorite pig;

          ' chooses icon #52 from the available Office icons

    End With

 

    ' 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

 

    ' You can set the toolbar position and visibility here if you like

    ' By default, it'll be visible when created

    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()

' This code will run when you click Button 1 added above

' Add a similar subroutine for each additional button you create on the toolbar

    ' This is just some silly example code.

    ' You'd put your real working code here to do whatever

    ' it is that you want to do

     With ActiveWindow.Selection.ShapeRange

        .Fill.ForeColor.RGB = RGB(255, 203, 5)

    End With

End Sub

 

Sub Button2()

' This code will run when you click Button 2 added above

' Add a similar subroutine for each additional button you create on the toolbar

    ' This is just some silly example code.

    ' You'd put your real working code here to do whatever

    ' it is that you want to do

     With ActiveWindow.Selection.ShapeRange

        .Fill.ForeColor.RGB = RGB(0, 114, 63)

    End With

End Sub

Open in new window

0
 

Author Comment

by:Ken_Chandler
ID: 24359577
Good morning,

I want to put an error handler on this macro so that if it is activated and an object is not selected in PPT  the user will get a message reading "Select an object, then apply the colour." Instead of the horrible VBA one that appears now.

Many thanks for any help

Regards

Ken
Sub Button2()
 

  

     With ActiveWindow.Selection.ShapeRange

        .Fill.ForeColor.RGB = RGB(0, 114, 63)

    End With

End Sub

Open in new window

0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24361275
ONe way would be to modify your sub to the snippet

Chris
Sub Button2()

Dim isok As Boolean

' This code will run when you click Button 2 added above

' Add a similar subroutine for each additional button you create on the toolbar

    ' This is just some silly example code.

    ' You'd put your real working code here to do whatever

    ' it is that you want to do

     On Error Resume Next

     isok = ActiveWindow.Selection.ShapeRange.HasTextFrame

     On Error GoTo 0

     If isok Then

         With ActiveWindow.Selection.ShapeRange

            .Fill.ForeColor.RGB = RGB(0, 114, 63)

        End With

    End If

End Sub

Open in new window

0
 

Author Comment

by:Ken_Chandler
ID: 24370842
Hi Chris,

this snippet has removed the ugly VBA error box from appearing but I am unable to bring up the new VBA box reading "Select an object, then apply the colour."

Am I doing something wrong?

Thank you for your help.

regards

Ken
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24371542
I missed that bit, I saw the error handler not the select mechanism.

SOmething can probably be done, i'm not sure how involved it will be to allow for the different shapes.  However excuse me if I ask you to raise a new question as it outside the scope of the existing question.

Note I think it will need the subs to be modified to analyse the application of the fill to the specific shape, and I am not particularly aware at this point of the scope large or small and therefore you may get a better response from someone else.

Chris
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 24491593
Ken

Any update?

Chris
0
 

Author Comment

by:Ken_Chandler
ID: 24661972
All done thank you..
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 24903619
Ken

Is it appropriate to close the question ... i'm trying to reduce my inbox!

Chris
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how to make a simple, pseudo-random number generator in Microsoft PowerPoint. The code checks the generated numbers against a list of numbers already generated to prevent duplication. We used this as a youth group activity but…
Introduction In all recent versions of PowerPoint it is possible to trigger animations. This means the animation takes place when a certain shape is clicked. This allows you to run animation “on demand” and outwith the normal sequence of mouse cl…
This video teaches viewers how to fit pictures into slides, crop and remove backgrounds, and alter photos to look more professional.
The viewer will learn how to edit the master slide. They will also learn how to combine multiple themes into one master slide to use them in their presentation.

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now