View Single Post
  #4   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

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