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

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

Post by dmJhZXhwZX » Sat, 21 Jun 2008 23:19:00

hip, 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 Auto_Open()
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\Microsof
 
 
 

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

Post by dmJhZXhwZX » Sun, 22 Jun 2008 01:21:01

k 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 Auto_Open()
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 A
 
 
 

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

Post by Dave Peter » Sun, 22 Jun 2008 04:38:15

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 Auto_Open()
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 wrote:

--

Dave Peterson
 
 
 

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

Post by dmJhZXhwZX » Sun, 22 Jun 2008 05:24:09

ave,
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 Auto_Open()
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 T
 
 
 

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

Post by Dave Peter » Sun, 22 Jun 2008 05:52:39

nd 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 wrote:

--

Dave Peterson
 
 
 

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

Post by dmJhZXhwZX » Tue, 24 Jun 2008 23:49:04

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.
 
 
 

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

Post by Dave Peter » Wed, 25 Jun 2008 01:00:45

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.






--

Dave Peterson
 
 
 

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

Post by dmJhZXhwZX » Wed, 25 Jun 2008 01:42:03

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.
 
 
 

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

Post by Dave Peter » Wed, 25 Jun 2008 02:05:30

Glad it's working for you.



--

Dave Peterson