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

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.

kskinne

Well-known Member
Joined
Feb 17, 2002
Messages
1,267
Office Version
  1. 365
Platform
  1. Windows
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
 

KniteMare

Board Regular
Joined
Mar 4, 2002
Messages
238
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
 

Juan Pablo González

MrExcel MVP
Joined
Feb 8, 2002
Messages
11,959
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.
 

tball

New Member
Joined
Aug 12, 2002
Messages
45

ADVERTISEMENT

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
 

Rusty

Board Regular
Joined
Apr 8, 2002
Messages
108

ADVERTISEMENT

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
 

Rusty

Board Regular
Joined
Apr 8, 2002
Messages
108
Hi,

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

Thanks,
Rusty
 

MartinK

Active Member
Joined
Oct 30, 2003
Messages
384
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
 

Colo

MrExcel MVP,
Joined
Mar 20, 2002
Messages
1,456
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
 

Watch MrExcel Video

Forum statistics

Threads
1,130,342
Messages
5,641,592
Members
417,224
Latest member
llama9207

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
Top