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

 

[Haluk]

@Colo:

Very nice code....

 

[Colo]

Thanks Raider,

I've heard the terrible news about the Terrorism in Istanbul...Are all your family and friends OK?
http://www.israelnewsagency.com/turkey_jewish_terrorism.html

 

[Smitty]

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.?

John Walkenbach suggestions @ http://j-walk.com/ss/excel/tips/tip67.htm

He has also put this together:

Sub ShowFaceIDs()
    Dim NewToolbar As CommandBar
    Dim NewButton As CommandBarButton
    Dim i As Integer, IDStart As Integer, IDStop As Integer
    
'   Delete existing FaceIds toolbar if it exists
    On Error Resume Next
    Application.CommandBars("FaceIds").Delete
    On Error GoTo 0
    
'   Add an empty toolbar
    Set NewToolbar = Application.CommandBars.Add _
        (Name:="FaceIds", temporary:=True)
    NewToolbar.Visible = True
    
'   Change the following values to see different FaceIDs
    IDStart = 1
    IDStop = 250
    
    For i = IDStart To IDStop
        Set NewButton = NewToolbar.Controls.Add _
            (Type:=msoControlButton, Id:=2950)
        NewButton.FaceId = i
        NewButton.Caption = "FaceID = " & i
    Next i
    NewToolbar.Width = 600
End Sub

Hope that helps,

Smitty

 

[Haluk]

Thanks Raider,

I've heard the terrible news about the Terrorism in Istanbul...Are all your family and friends OK?
http://www.israelnewsagency.com/turkey_jewish_terrorism.html

Hi Colo;

Thanks for your concern about the last terrorism events in Istanbul. My family and all my close friends are OK for the time being. But as you know, terrorism has no rules and nobody can guess what, when and where the next attack will happen again.

As you know, just 5-6 days ago the first attack caused 25 innocent people to die and with the last attack on yesterday, this number has been increased by 28 more, with over 500 injured people.

I hope all these terrible events to stop without causing any more loss of life....

 

[FaceIDguide]

This website has all the FaceID icons by category and number.
http://www.faceidguide.com

 

[Michael Simpson]

MANY thanks Colo

I was trying to do something similar. I wanted a menu option to have a faceid of a national flag (none of which exist in FACEID that I could see).

I googled a bit until I found some small flags on websites (basically in conjunction with the option to translate the webpage) and saved the flags to my desktop. I then select a "technical sheet" I have in my spreadsheet and inserted the desktop pictures (flags) to specific cells.

My code is now as follows (improvements to the code are gratefully accepted). B3 contains the inserted english flag, B2 the Swedish one

    Set sh = Sheets("Technical Sheet") 'Change here to the worksheet for shapes
    Range("B3").Select                  ' Select the "english flag"
    Set shp = sh.Shapes(2)
    shp.CopyPicture Format:=xlBitmap
    
    With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
        .Caption = menu_texts(4)
        .OnAction = "change_language_english"
        .Tag = "ENGLISH"
        '.FaceId = 33
        .PasteFace
    End With
    
    Range("B2").Select                  ' Select the "english flag"
    Set shp = sh.Shapes(1)
    shp.CopyPicture Format:=xlBitmap
    
    With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
        .Caption = menu_texts(5)
        .OnAction = "change_language_swedish"
        .Tag = "SWEDISH"
        '.FaceId = 34
        .PasteFace
    End With

Worked like a charm.

Thanks again