Ken_Chandler
asked on
How to place images on toolbar macro buttons using VBA
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
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
Ken_Chandler,
Replace the path to the graphic as befits your graphic:
Set picPicture = stdole.StdFunctions.LoadPi cture("C:\ DELL\E-Cen ter\images \finish_bu tton_en.gi f")
Chris
Replace the path to the graphic as befits your graphic:
Set picPicture = stdole.StdFunctions.LoadPi
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
ASKER
Hi Chris,
Thank you for this, I will give it a try and let you know how I get on.
Regards
Ken
Thank you for this, I will give it a try and let you know how I get on.
Regards
Ken
ASKER
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
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
Apologies ... the variable needs to be defined:
Dim picPicture As IPictureDisp
Chris
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
ASKER
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
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
ONe way would be to modify your sub to the snippet
Chris
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
ASKER
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
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
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
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
Ken
Any update?
Chris
Any update?
Chris
ASKER
All done thank you..
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
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