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