Need help w using custom image for custom toolbar in Excel 2007

[vbaexperimenter]

I created the toolbar as an add in using the method I found at:
http://www.contextures.com/xltoolbar02.html

It is VBA for 2003 but works in 2007. I have found various suggestions
online to add an image, but most of it is using xml, and I'm just using VB.
Can anyone tell me or direct me where to go to remove the caption name and
replace it with an image?

I found this thread, but I don't know enough about VB to know how to
incorporate it into the code listed on the link above, or if that is even
possible. My educated guess is no since the code I'm using is for the whole
menu/toolbar and the code from the thread below looks to be refering to 1
button.
http://www.microsoft.com/office/com...3fbd&mid=6b6bc178-6758-47b0-a231-d43c814c205b

Any help would be appreciated. FYI, adding the customized toolbar as an add
in is what I'm looking for, which is why the xml approach didn't seem to work
well for me.

 

[Chip Pearson]

Try something like the following to load a image file as the picture for a
command bar button.

Sub AAA()
Dim Pict As StdPicture
Dim FileName As String
Dim Ctrl As Office.CommandBarButton
FileName = "C:\Path\SomeFile.bmp" '<<< CHANGE
Set Ctrl = Application.CommandBars("Test").Controls(1) '<<< CHANGE
Set Pict = LoadPicture(FileName)
Ctrl.Picture = Pict
End Sub


--
Cordially,
Chip Pearson
Microsoft Most Valuable Professional
Excel Product Group
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)

 

[vbaexperimenter]

Chip, that worked, but now I'm showing two toolbars instead of just one. One
with the name/caption and the other as just the image. The one with just the
image is the one I'm looking for. Here is my current code, it includes the
macro I'm using as well. My macro for the AAA is in there as well. I put your
code under that Sub. I tried to remove various coding, but I couldn't get the
toolbar with the name/caption to go away. Here is what I have as my current
code. Both toolbars work btw. Any suggestions would be helpful.

Option Explicit

Public Const ToolBarName As String = "Tickmarks"
'===========================================
Sub Autpen()
Call CreateMenubar
End Sub

'===========================================
Sub Auto_Close()
Call RemoveMenubar
End Sub

'===========================================
Sub RemoveMenubar()
On Error Resume Next
Application.CommandBars(ToolBarName).Delete
On Error GoTo 0
End Sub

'===========================================
Sub CreateMenubar()

Dim iCtr As Long

Dim MacNames As Variant
Dim TipText As Variant

Call RemoveMenubar

MacNames = Array("aaa", _
"bbb")

TipText = Array("AAA tip", _
"BBB tip")

With Application.CommandBars.Add
.Name = ToolBarName
.Left = 200
.Top = 200
.Protection = msoBarNoProtection
.Visible = True
.Position = msoBarLeft

For iCtr = LBound(MacNames) To UBound(MacNames)
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)
.TooltipText = TipText(iCtr)
End With
Next iCtr
End With


Dim Pict As StdPicture
Dim FileName As String
Dim Ctrl As Office.CommandBarButton
FileName = "D:\Program Files\Microsoft Office\Office12\Tickmarks\TB.bmp"
'<<< CHANGE
Set Ctrl = Application.CommandBars("Tickmarks").Controls(1) '<<< CHANGE
Set Pict = LoadPicture(FileName)
Ctrl.Picture = Pict
End Sub




'===========================================
Sub AAA()
InsertPicture "D:\Program Files\Microsoft
Office\Office12\Tickmarks\TB.bmp", ActiveCell, True, True
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCell
t = .Top
l = .Left
If CenterH Then
w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1
End If
If CenterV Then
h = .Offset(1, 0).Top - .Top
t = t + h / 2 - p.Height / 2
If t < 1 Then t = 1
End If
End With
' position picture
With p
.Top = t
.Left = l
End With
Set p = Nothing

Dim Pict As StdPicture
Dim FileName As String
Dim Ctrl As Office.CommandBarButton
FileName = "D:\Program Files\Microsoft Office\Office12\Tickmarks\TB.bmp"
'<<< CHANGE
Set Ctrl = Application.CommandBars("Tickmarks").Controls(1) '<<< CHANGE
Set Pict = LoadPicture(FileName)
Ctrl.Picture = Pict
End Sub


'===========================================
Sub BBB()
MsgBox "bbb"
End Sub

 

[vbaexperimenter]

Ok Scratch my last question. I think I got that figured out. My problem right
now is that the button appears as 1 & 2 until I press them then it turns into
the picture that I want. Here is the code I currently have:

Option Explicit

Public Const ToolBarName As String = "MyToolbarName"
'===========================================
Sub Autpen()
Call CreateMenubar
End Sub

'===========================================
Sub Auto_Close()
Call RemoveMenubar
End Sub

'===========================================
Sub RemoveMenubar()
On Error Resume Next
Application.CommandBars(ToolBarName).Delete
On Error GoTo 0
End Sub

'===========================================
Sub CreateMenubar()

Dim iCtr As Long

Dim MacNames As Variant
Dim CapNamess As Variant
Dim TipText As Variant

Call RemoveMenubar

MacNames = Array("aaa", _
"bbb")

CapNamess = Array("", _
"")

TipText = Array("AAA tip", _
"BBB tip")

With Application.CommandBars.Add
.Name = ToolBarName
.Left = 200
.Top = 200
.Protection = msoBarNoProtection
.Visible = True
.Position = msoBarLeft

For iCtr = LBound(MacNames) To UBound(MacNames)
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)
.Caption = CapNamess(iCtr)
.Style = msoButtonIcon
.FaceId = 71 + iCtr
.TooltipText = TipText(iCtr)
End With
Next iCtr
End With
End Sub

'===========================================
Sub AAA()
InsertPicture "D:\Program Files\Microsoft
Office\Office12\Tickmarks\TB.bmp", ActiveCell, True, True
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCell
t = .Top
l = .Left
If CenterH Then
w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1
End If
If CenterV Then
h = .Offset(1, 0).Top - .Top
t = t + h / 2 - p.Height / 2
If t < 1 Then t = 1
End If
End With
' position picture
With p
.Top = t
.Left = l
End With
Set p = Nothing

Dim Pict As StdPicture
Dim FileName As String
Dim Ctrl As Office.CommandBarButton
FileName = "D:\Program Files\Microsoft Office\Office12\Tickmarks\TB.bmp"
'<<< CHANGE
Set Ctrl = Application.CommandBars(ToolBarName).Controls(1) '<<< CHANGE
Set Pict = LoadPicture(FileName)
Ctrl.Picture = Pict

End Sub

'===========================================
Sub BBB()
InsertPicture2 "D:\Program Files\Microsoft
Office\Office12\Tickmarks\IM.bmp", ActiveCell, True, True
End Sub

Sub InsertPicture2(PictureFileName As String, TargetCell As Range, _
CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCell
t = .Top
l = .Left
If CenterH Then
w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1
End If
If CenterV Then
h = .Offset(1, 0).Top - .Top
t = t + h / 2 - p.Height / 2
If t < 1 Then t = 1
End If
End With
' position picture
With p
.Top = t
.Left = l
End With
Set p = Nothing

Dim Pict As StdPicture
Dim FileName As String
Dim Ctrl As Office.CommandBarButton
FileName = "D:\Program Files\Microsoft Office\Office12\Tickmarks\IM.bmp"
'<<< CHANGE
Set Ctrl = Application.CommandBars(ToolBarName).Controls(2) '<<< CHANGE
Set Pict = LoadPicture(FileName)
Ctrl.Picture = Pict

End Sub

 

[Dave Peterson]

I don't quite understand what you're accomplishing by inserting the picture by
clicking on the button. You want the picture on the button right away--and you
want to have a macro assigned to the button that actually does something
important.

Maybe you could (manually) put the pictures on a worksheet in the workbook with
the code. Then the macro that creates the toolbar can use those pictures. That
way, you don't have to worry about the pictures not being available.

If you want to try:

Option Explicit
Public Const ToolBarName As String = "MyToolbarName"
Sub Autpen()
Call CreateMenubar
End Sub
Sub Auto_Close()
Call RemoveMenubar
End Sub
Sub RemoveMenubar()
On Error Resume Next
Application.CommandBars(ToolBarName).Delete
On Error GoTo 0
End Sub
Sub CreateMenubar()

Dim iCtr As Long

Dim MacNames As Variant
Dim CapNames As Variant
Dim TipText As Variant
Dim PictNames As Variant
Dim PictWks As Worksheet

Call RemoveMenubar

MacNames = Array("aaa", _
"bbb")

CapNames = Array("AAA Caption", _
"BBB Caption")

TipText = Array("AAA tip", _
"BBB tip")

PictNames = Array("Pic1", "Pic2")

Set PictWks = ThisWorkbook.Worksheets("Pictures")

With Application.CommandBars.Add
.Name = ToolBarName
.Left = 200
.Top = 200
.Protection = msoBarNoProtection
.Visible = True
.Position = msoBarFloating

For iCtr = LBound(MacNames) To UBound(MacNames)
PictWks.Pictures(PictNames(iCtr)).Copy
With .Controls.Add(Type:=msoControlButton)
.OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)
.Caption = CapNames(iCtr)
.Style = msoButtonIconAndCaption
.PasteFace
.TooltipText = tip_text(iCtr)
End With
Next iCtr

End With
End Sub
Sub AAA()
MsgBox "aaa"
End Sub
Sub BBB()
MsgBox "bbb"
End Sub

The AAA and BBB subs are just stubs. You can put your macro code that does the
real work there--or call your macros from them.

 

[vbaexperimenter]

Dave,
I essentially want a toolbar where the buttons are labled with the image
the macro will insert into the worksheet. I also need it as an addin so it
can be added to other computers/users. I inserted all the pictures to my
file tickmarks.xlam. I then copied and pasted your code into the module. It
keeps erroring out on the line:

PictWks.Pictures(PictNames(iCtr)).Copy

Here is the code again with your changes and the name of the sheet and
pictures

Option Explicit
Public Const ToolBarName As String = "MyToolbarName"
Sub Autpen()
Call CreateMenubar
End Sub
Sub Auto_Close()
Call RemoveMenubar
End Sub
Sub RemoveMenubar()
On Error Resume Next
Application.CommandBars(ToolBarName).Delete
On Error GoTo 0
End Sub
Sub CreateMenubar()

Dim iCtr As Long

Dim MacNames As Variant
Dim CapNames As Variant
Dim TipText As Variant
Dim PictNames As Variant
Dim PictWks As Worksheet

Call RemoveMenubar

MacNames = Array("Prior_Year", _
"Recalculated")

CapNames = Array("Prior_Year", _
"Recalculated")

TipText = Array("Prior_Year", _
"Recalculated")

PictNames = Array("Prior_Year", "Recalculated")

Set PictWks = ThisWorkbook.Worksheets("Pictures")

With Application.CommandBars.Add
..Name = ToolBarName
..Left = 200
..Top = 200
..Protection = msoBarNoProtection
..Visible = True
..Position = msoBarFloating

For iCtr = LBound(MacNames) To UBound(MacNames)
PictWks.Pictures(PictNames(iCtr)).Copy
With .Controls.Add(Type:=msoControlButton)
..OnAction = "'" & ThisWorkbook.Name & "'!" & MacNames(iCtr)
..Caption = CapNames(iCtr)
..Style = msoButtonIconAndCaption
..PasteFace
..TooltipText = TipText(iCtr)
End With
Next iCtr

End With
End Sub

'===========================================
Sub Prior_Year()
InsertPicture "D:\Program Files\Microsoft
Office\Office12\Tickmarks\Prior_Year.bmp", ActiveCell, True, True
End Sub

Sub InsertPicture(PictureFileName As String, TargetCell As Range, _
CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCell
t = .Top
l = .Left
If CenterH Then
w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1
End If
If CenterV Then
h = .Offset(1, 0).Top - .Top
t = t + h / 2 - p.Height / 2
If t < 1 Then t = 1
End If
End With
' position picture
With p
..Top = t
..Left = l
End With
Set p = Nothing

End Sub

'===========================================
Sub Recalculated()
InsertPicture2 "D:\Program Files\Microsoft
Office\Office12\Tickmarks\Recalculated.bmp", ActiveCell, True, True
End Sub

Sub InsertPicture2(PictureFileName As String, TargetCell As Range, _
CenterH As Boolean, CenterV As Boolean)
' inserts a picture at the top left position of TargetCell
' the picture can be centered horizontally and/or vertically
Dim p As Object, t As Double, l As Double, w As Double, h As Double
If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
If Dir(PictureFileName) = "" Then Exit Sub
' import picture
Set p = ActiveSheet.Pictures.Insert(PictureFileName)
' determine positions
With TargetCell
t = .Top
l = .Left
If CenterH Then
w = .Offset(0, 1).Left - .Left
l = l + w / 2 - p.Width / 2
If l < 1 Then l = 1
End If
If CenterV Then
h = .Offset(1, 0).Top - .Top
t = t + h / 2 - p.Height / 2
If t < 1 Then t = 1
End If
End With
' position picture
With p
..Top = t
..Left = l
End With
Set p = Nothing

End Sub

 

[Dave Peterson]

And you have pictures named Prior_Year and Recalculated on a worksheet named
Pictures in that workbook with the code?

If no, then you have some work to do.

If yes, what error do you see?

 

[vbaexperimenter]

Dave,
Sorry I didn't get back to you sooner. Unless I need to rename the bitmaps
after they are copied into the worksheet, yes the bitmaps with those names
are in the Pictures worksheet. Below are the steps that I have taken.

After your message, I deleted my current tickmarks.xlam, and started with a
blank document. I inserted all the bitmaps that I will need (total of 15)
into the document. I inserted them using the normal insert method (Insert
ribbon - Picture). I didn't touch the bitmaps I left them as is. I renamed
the Sheet1 tab to Pictures(which I copied and pasted the word "Pictures" from
your code). I then saved this new document as tickmarks.xlam. I then went
into the VB editor (Alt - F11) and copied and pasted your code. I then added
the macro's. The names that I added to the code for the bitmaps were
directly copied and pasted from the filename of the original bitmap in my
tickmark folder. I assumed that picture in the workbook woudl take the same
name as the original file name. The only error that comes up is "Compile
error: Syntax Error" and that line is highlighted.

Again any help would be appreciated.

 

[Dave Peterson]

A Syntax error is different from the other error you got.

Maybe you did all that stuff _and_ made changes to the code?????

But inserted pictures don't inherit the name of the file.

Rightclick on one of the pictures and look in the NameBox (to the left of the
formulabar). What do you see there?

My bet it is something like:
Picture 1
through
Picture 15
(notice the space in the name, too!)

Those are the names you have to use in your code.

PictNames = Array("Pic1", "Pic2")

would become
PictNames = Array("Picture 1",
"Picture 2")
(and so forth)

If you want to give the pictures meaningful names, select the picture and type
the new name into the namebox. Remember to hit enter when you're done typing
the new name.

 

[vbaexperimenter]

Ok, so I had a blonde moment I didn't even think of checking the namebox.
I looked at the properties, which didn't have a name. Now it is working,
Thanks for your help.

 

[Dave Peterson]

Glad it's working for you.

Ok, so I had a blonde moment I didn't even think of checking the namebox.
I looked at the properties, which didn't have a name. Now it is working,
Thanks for your help.