Custom face on a button without using clipboard?

[Guest]

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 don’t want to clear
the clipboard.

 

[keepITcool]

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").CopyPicture
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 >

 

[Tom Ogilvy]

See possible answer to later posting of this question.

 

[Guest]

Cheers I'll give it a try. As for 3 postings it kept saying it failed bu I
guess not!