View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
vbaexperimenter vbaexperimenter is offline
external usenet poster
 
Posts: 13
Default Need help w using custom image for custom toolbar in Excel 200

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 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\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