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-2018 (c) Shyam Pillai. All rights reserved.