Customized Faceid ?

[tball]

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

 

[kskinne]

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]

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]

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]

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

 

[XL-Dennis]

Hi,
In addition to Juan´s recommendation I personally has a favorite free Face-ID tool made by Shyam Pillai

http://www.mvps.org/skp/faceid.htm

The source codes are also available

Kind regards,
Dennis

 

[Rusty]

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)

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

Thanks,
Rusty

 

[Rusty]

Hi,

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

Thanks,
Rusty

 

[MartinK]

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]

Hello Rusty,

Something like this???
Please place Auto shpas or bitmap in the sheet1 before run this 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