View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
keepITcool keepITcool is offline
external usenet poster
 
Posts: 2,253
Default Custom face on a button without using clipboard?



IF you program for xlXP and newer:

You can use the Picture and Mask properties of the commandbarcontrol
I use an imagelist control to store the bitmaps.
(you'll need 2 for each icon)..
I use ArtIcons Pro (from aha-soft.com), which has an option
to export bitmaps AND masks.

(make sure they are 16x16 and 24bit or 256 color,
DO NOT USE 32bit icons)


the imagelist control can be in a userform or embedded on a sheet.

for older versions I prefer to store my icons in an embedded Forms Image
control. (Streched/No Borders,Backcolor ButtonFace) rather then as an
Excel.Picture.. gives less distortion and sharper image with partly
transparent icons.

Option Explicit

Const csAPP = "my application"
Const csTAG = "myAPPid"
Const csMNU = "custom userform"

Private Sub Auto_Open()
doMenu True
End Sub

Private Sub Auto_Close()
doMenu False
End Sub

Private Sub doMenu(fDo As Boolean)
Dim cCtl As CommandBarControl

On Error Resume Next
With Application.CommandBars
Do
Set cCtl = .FindControl(ID:=0, Tag:=csTAG)
If Not cCtl Is Nothing Then cCtl.Delete
Loop Until cCtl Is Nothing
If Not fDo Then Exit Sub

'Use the Tools Menu
Set cCtl = .FindControl(ID:=30007).Controls.Add( _
Type:=msoControlButton, Temporary:=True)
cCtl.Tag = csTAG
cCtl.Caption = csMNU
cCtl.OnAction = ThisWorkbook.Name & "!doForm"
cCtl.FaceId = 59
cCtl.Style = msoButtonAutomatic
'Customize Icon
doIcon cCtl
'Make a copy on the Standard bar :)
With cCtl.Copy(Bar:=Application.CommandBars("Standard") )
.Caption = csAPP
.Style = msoButtonIcon
End With
End With
End Sub


Private Sub doIcon(ByVal btn As CommandBarButton)
Dim pic As Object
If Val(Application.Version) < 10 Then
ThisWorkbook.Worksheets(1).Shapes("image1").CopyPi cture
btn.PasteFace
ThisWorkbook.Worksheets(1).Range("iv65536").Copy
Application.CutCopyMode = False
Else
'This will be run by xlXP+ only.
'CallByName is used to avoid compile errors in xl2k

#If VBA6 Then
Set pic = ThisWorkbook.Worksheets(1) _
.OLEObjects("imagelist1").Object
CallByName btn, "Picture", VbLet, pic.ListImages("pict").Picture
CallByName btn, "Mask", VbLet, pic.ListImages("mask").Picture
#End If
End If
End Sub

Public Sub DoForm()
MsgBox "Hi"
End Sub


keepITcool

< email : keepitcool chello nl (with @ and .)
< homepage: http://members.chello.nl/keepitcool


"?B?TmlnZWw=?=" wrote:

I want to put a custom face on a button. Is the only way to do this
PasteFace? Can I not just specify a file path for the image.

The problem is I set up these toolbars on startup and dont want to
clear the clipboard.