OfficeTips Home || VBA Section || General Section || Download Section || Privacy Policy

FaceID Browser Source Code

Many of you have requested for the source code for the FaceID browser. So I have included the core routines here. The BarOpen and BarClose are routines which are invoked when the add-in is loaded & unloaded respectively. The call could be made from the Auto_Open /Auto_Close routines or Open/Close events supported by the host application. lngSetMarker is the global set marker used to keep track of the starting ID of the set to be displayed. DrawIconID routine is the core routine in which we assign the new set of numbers to the FaceID property of the controls. PrevID & NextID are called whenever the subsequent icons have to be drawn.

 

 

 Name          : Face ID Browser for Microsoft Office™
 Version       : 1.0
 Author        : Shyam Pillai
 Copyright     : © 2001-2004 Shyam Pillai. All rights reserved.
 Email         : Shyam@MVPs.Org
 Description   : FaceID Browser is a handy tool for developers who want to determine 
      		 the FaceIDs of hundreds of Microsoft Office™ menu icons for use in
                 their custom menus.
 Date          : 9th Feb 2001
 Site          : OfficeTips
 URL           : http://skp.mvps.org
 
 


BarOpen
looks for the existence of the 'FaceID Browser' toolbar in the host application by attempting to get a reference to it. However if it fails to do so (when the bar does not exist) it will create a new and assign three buttons control to it : About, Previous & Next. Finally it executes the macro associated with the Next button and displays the toolbar.

BarClose is invoked when the add-in is unload. We store to value of the marker and the current visibility state of the toolbar to the registry.


Option Explicit

Const APP_NAME = "FaceID Browser"
' The number of icons to be displayed in a set.
Const ICON_SET = 100
Public lngSetMarker As Long

Private Sub BarOpen()
    Dim xBar As CommandBar
    Dim xBarButton As CommandBarButton
    Dim bCreatedNew As Boolean

    ' Read the value in the registry
    lngSetMarker = GetSetting(APP_NAME, "Preferences", "LastSet", 1)

    On Error Resume Next

    ' Try to get a reference to the 'FaceID Browser' toolbar if
    ' it exists.
    Set xBar = CommandBars(APP_NAME)

    ' If it doesn't exist then create a new toolbar
    If xBar Is Nothing Then
        Set xBar = CommandBars.Add(Name:=APP_NAME, Temporary:=False)
        bCreatedNew = True
    End If

    Set xBarButton = xBar.FindControl(Tag:="msoTagAboutMe")

    If xBarButton Is Nothing Then
        Set xBarButton = xBar.Controls.Add(Type:=msoControlButton, Before:=1)
        With xBarButton
            .Caption = "About..."
            .Style = msoButtonCaption

            Select Case Application.Name
            Case "Microsoft PowerPoint"
                .OnAction = "IDBrowse.ppa!About"
            Case "Microsoft Excel"
                .OnAction = "IDBrowse.xla!About"
            Case "Microsoft Word"
                .OnAction = "IDBrowse.dot!About"
            End Select

            .DescriptionText = "Information about the author"
            .Tag = "msoTagAboutMe"
        End With
    End If

    Set xBarButton = xBar.FindControl(Tag:="msoTagPrev100")

    If xBarButton Is Nothing Then
        Set xBarButton = xBar.Controls.Add(Type:=msoControlButton, Before:=2)
    End If

    With xBarButton
        .BeginGroup = True
        .Style = msoButtonCaption
        .TooltipText = "Previous 100 FaceId values"
        .Caption = "« Previous  "

        Select Case Application.Name
        Case "Microsoft PowerPoint"
            .OnAction = "IDBrowse.ppa!PrevID"
        Case "Microsoft Excel"
            .OnAction = "IDBrowse.xla!PrevID"
        Case "Microsoft Word"
            .OnAction = "IDBrowse.dot!PrevID"
        End Select

        .DescriptionText = "Displays icons associated with previous 100 face ids"
        .Tag = "msoTagPrev100"
        .Enabled = False
    End With

    Set xBarButton = xBar.FindControl(Tag:="msoTagNext100")

    If xBarButton Is Nothing Then
        Set xBarButton = xBar.Controls.Add(Type:=msoControlButton, Before:=3)
    End If

    With xBarButton
        .Style = msoButtonCaption
        .Caption = "      Next »"
        .TooltipText = "Next 100 FaceId values "

        Select Case Application.Name
        Case "Microsoft PowerPoint"
            .OnAction = "IDBrowse.ppa!NextID"
        Case "Microsoft Excel"
            .OnAction = "IDBrowse.xla!NextID"
        Case "Microsoft Word"
            .OnAction = "IDBrowse.dot!NextID"
        End Select

        .DescriptionText = "Displays icons associated with next 100 face ids"
        .Tag = "msoTagNext100"
    End With

    With xBar

        .FindControl(Tag:="msoTagNext100").Execute

        If bCreatedNew Then
            .Width = 246
            .Top = 100
            .Left = 100
        End If

        .Visible = GetSetting(APP_NAME, "Preferences", "Visible", True)

    End With
End Sub
 
Private Sub BarClose()
On Error Resume Next
' Save the state of the toolbar and the currrent active set to the registry
SaveSetting APP_NAME, "Preferences", "Visible", Val(CommandBars(APP_NAME).Visible)
SaveSetting APP_NAME, "Preferences", "LastSet", lngSetMarker - ICON_SET
CommandBars(APP_NAME).Visible = False
End Sub

 


DrawIconID is called by NextID & PrevID. The arguments which DrawIconID requires are the starting icon ID number, the end icon ID number and a boolean value which determines whether the lngSetMarker has to deducted or incremented. The existence of the control on which the icon has to be drawn is checked and recreated incase it doesn't exist.

 

			
Sub DrawIconID(StartID As Long, EndID As Long, bPrev As Boolean)

    Dim xBar As CommandBar
    Dim xBarButton As CommandBarButton
    Dim lngID As Long
    Dim intIconBtnIndex As Integer

    On Error Resume Next
    Set xBar = CommandBars(APP_NAME)

    intIconBtnIndex = 1

    For lngID = StartID To EndID
        Set xBarButton = xBar.FindControl(Tag:="msoFaceID:" & intIconBtnIndex)

        If xBarButton Is Nothing Then
            Set xBarButton = xBar.Controls.Add(Type:=msoControlButton, _
						Before:=(intIconBtnIndex + 3))

            With xBarButton
                .Tag = "msoFaceID:" & intIconBtnIndex
                .Style = msoButtonIcon
            End With

        End If

        With xBarButton
            If intIconBtnIndex = 1 Then
                .BeginGroup = True
            End If

            .TooltipText = "FaceID: " & lngID
            .FaceId = lngID

        End With
        intIconBtnIndex = intIconBtnIndex + 1
    Next lngID

    ' Increment/Decrement the Icon set counter
    If bPrev Then
        lngSetMarker = lngSetMarker - ICON_SET
    Else
        lngSetMarker = lngSetMarker + ICON_SET
    End If

    ' Enable/Disable the 'Previous...' button
    If lngSetMarker = ICON_SET + 1 Then
        xBar.FindControl(Tag:="msoTagPrev100").Enabled = False
    Else
        xBar.FindControl(Tag:="msoTagPrev100").Enabled = True
    End If

End Sub
 
Private Sub NextID()
    DrawIconID lngSetMarker, lngSetMarker + (ICON_SET - 1), False
End Sub

Private Sub PrevID()
    DrawIconID (lngSetMarker - (2 * ICON_SET)), (lngSetMarker - ICON_SET - 1), True
End Sub
 

FaceID Browser download page


Copyright 1999-2014 (c) Shyam Pillai. All rights reserved.