Customized Faceid ?

tball

New Member
Joined
Aug 12, 2002
Messages
45
Does anyone know if its possible to assigning a customized faceid (bitmap,picture) to a toolbar menu item.

I know manually I can edit the button image but I want to automate the process. I currently have some code that creates a tool bar every time the workbook is opened and destroys it every time it is closed.



Thanks
Tball


‘ **************************************
Sub CreateToolbarMenu()

Dim NewToolBarMenu As CommandBar
Dim NewToolBarItem As CommandBarControl

Set NewToolBarMenu = Application.CommandBars.Add("newToolbar")
NewToolBarMenu.Visible = True
Set NewToolBarItem = NewToolBarMenu.Controls.Add
With NewToolBarItem
.Caption = "New Button"
.OnAction = "MacroName"
.Tag = "my_toolbars"
.FaceId = 346
‘ I want to replace 346 with a bmp or picture
‘ or somehow draw my own faceid
End With

End Sub

‘ **************************************
Sub DestryToolbarMenu()

Dim ToolBarMenu As CommandBar
Dim NewToolBarItem As CommandBarControl

Set ToolBarMenu = Application.CommandBars("newToolbar")
ToolBarMenu.Delete

End Sub
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
related question:

where can i find out what each faceid no. in excel signifies? for example, 2950 is a smiley face. is there a list somewhere that defines each faceid no.?

thanks,
kevin
 
Upvote 0
tball:
As you know we have a mutual intrest in this question. I started looking and:::

Here is a start:

The F1 Help tells us that for .FaceId
The value of the FaceId property for a command bar button with a custom face is 0 (zero).

Now the question is How to address the Custom face??

kskinne: PM me I'll send you a file with access to all 3000 face id's. You need to look at the code and change the range of numbers as all 3000 do not fit on a page very well.



Yours in EXCELent Frustration

KniteMare

Hey, if they call it an Aqua Lung, then why is it not filled with water?
This message was edited by KniteMare on 2002-09-06 08:20
 
Upvote 0
As far as I know, you can't have a Custom FaceID number, you have to use the PasteFace method.

To get the FaceID's, and its correspondings, J-Walk has a cool AddIn that lets you browse them. In the MVP area of Stephen Bullen's there's also a workbook that has this info.
 
Upvote 0
I found it. :)

replace the
.faceid =346
with
Sheet1.Shapes ("Pic1").copy
.pasteface

Where "Pic1" is an inserted picture one Sheet1

or from a file.

If CopyPictureFromFile shtCustomIcons,ThisWorkbook.Path & "allowparking.bmp") Then
.PasteFace
End If


Function CopyPictureFromFile(TargetWS As Worksheet, SourceFile As String) As Boolean
' inserts a picture from SourceFile into TargetWS
' copies the picture to the clipboard
' deletes the inserted picture
' returns TRUE if a picture is copied to the clipboard
' the picture can be pasted from the clipboard e.g. to a custom commbarbutton
Dim p As Object
CopyPictureFromFile = False
If TargetWS Is Nothing Then Exit Function
If Len(Dir(SourceFile)) = 0 Then Exit Function
On Error GoTo NoPicture
Set p = TargetWS.Pictures.Insert(SourceFile)
p.CopyPicture xlScreen, xlPicture
p.Delete
Set p = Nothing
On Error GoTo 0
CopyPictureFromFile = True
Exit Function
NoPicture:
End Function

http://www.erlandsendata.no/english/downloads/commandbars.htm
 
Upvote 0
Hi,

This looks great, but I can't seem to get this to work....

Can anyone tell me where I am going wrong? I am getting a :

---

Compile Error:

Argument Not Optional

---

on the Replace fucntion

my code is: (as below)

Code:
Replace the
.FaceId = 346
with
Sheet1.Shapes("Pic1").Copy
.PasteFace

Thanks,
Rusty
 
Upvote 0
Hi,

Does nobody know this? Or am I missing something really obvious?

Thanks,
Rusty
 
Upvote 0
Hi Rusty,
I think TBall meant

'Replace the line:
.FaceId = 346
'with this lines:
Sheet1.Shapes("Pic1").Copy
.PasteFace

If you copied as it is, of course it spits an error as Replace does not recognize "the" as valid argument.

Sorry if I am missing the point.

Martin
 
Upvote 0
Hello Rusty,

Something like this???
Please place Auto shpas or bitmap in the sheet1 before run this code.

Code:
Sub CreateToolbarMenu()
    Dim lngCnt As Long, shp As Shape, sh As Worksheet
    On Error Resume Next
    Application.CommandBars("newToolbar").Delete
    On Error GoTo 0
    Set sh = Sheets(1) 'Change here to the worksheet for shapes
    Application.CommandBars.Add(Name:="newToolbar", Temporary:=True).Visible = True
    With Application.CommandBars("newToolbar")
        For lngCnt = 1 To sh.Shapes.Count
            Set shp = sh.Shapes(lngCnt)
            .Controls.Add Type:=msoControlButton
            If shp.Type = 13 Or shp.Type = 7 Then
                shp.CopyPicture Format:=xlBitmap
            Else
                shp.Copy
            End If
            With .Controls(lngCnt)
                .PasteFace
                .OnAction = "TestProc" & lngCnt
                .Style = msoButtonlngCntnAndCaption
                .Caption = "New Button" & lngCnt
                .Tag = "my_toolbars"
                .TooltipText = "PopHint" & lngCnt
            End With
        Next
    End With
    Set sh = Nothing
    Set shp = Nothing
End Sub

Sub Auto_Close()
    On Error Resume Next
    Application.CommandBars("newToolbar").Delete
End Sub

Sub TestProc1()
    MsgBox "Hello world"
End Sub

Sub TestProc2()
    MsgBox "Hello world"
End Sub
 
Upvote 0

Forum statistics

Threads
1,217,760
Messages
6,138,447
Members
450,137
Latest member
HANHAN

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top