Copy the code below in a module,
name it as FaceIdExplorerModule,
and then save the file as faceid.xla
Option Explicit
Private StartFaceId As Integer
Private Const SAppName = "FaceId Explorer"
Private Const SPreferencesSection = "Preferences"
Private Const SVisibilityKey = "Visible"
Private Const SRowIndexKey = "RowIndex"
Private Const SPositionKey = "Position"
Private Const STopKey = "Top"
Private Const SLeftKey = "Left"
Private Const SWidthKey = "Width"
Private Const SHeightKey = "Height"
Private Const SStartFaceIdKey = "StartFaceId"
Private Const SFaceIdCommandBarName = "FaceId Explorer"
Private Const BUTTON_ABOUT = 1
Private Const BUTTON_PREVIOUS = 2
Private Const BUTTON_NEXT = 3
Private Const BUTTON_FACEID = 4
Private Const FIRST_FACEID = 1
Sub FaceId_AddinInstall()
AddinInitialize
End Sub
Sub FaceId_AddinUninstall()
AddinShutdown
End Sub
Sub Auto_Open()
AddinInitialize
End Sub
Sub Auto_Close()
AddinShutdown
End Sub
Sub AddinInitialize()
StartFaceId = FIRST_FACEID
CreateToolBar
SetPreviousButtonState
AssignFaceId
End Sub
Sub AddinShutdown()
Dim Toolbar As CommandBar
On Error Resume Next
Set Toolbar = CommandBars(SFaceIdCommandBarName)
If Not (Toolbar Is Nothing) Then
With Toolbar
SaveSetting SAppName, SPreferencesSection, _
SVisibilityKey, IIf(.Visible, "1", "0")
SaveSetting SAppName, SPreferencesSection, _
SRowIndexKey, Trim(Str(.RowIndex))
SaveSetting SAppName, SPreferencesSection, _
SPositionKey, Trim(Str(.Position))
SaveSetting SAppName, SPreferencesSection, _
STopKey, Trim(Str(.Top))
SaveSetting SAppName, SPreferencesSection, _
SLeftKey, Trim(Str(.Left))
SaveSetting SAppName, SPreferencesSection, _
SWidthKey, Trim(Str(.Width))
SaveSetting SAppName, SPreferencesSection, _
SHeightKey, Trim(Str(.Height))
SaveSetting SAppName, SPreferencesSection, _
SStartFaceIdKey, Trim(Str(StartFaceId))
.Delete
End With
End If
End Sub
Sub CreateToolBar()
Dim Toolbar As CommandBar
Dim Button As CommandBarButton
Dim i As Integer
Dim Begin As Boolean
Dim TotalWidth As Integer
Dim WidthStr As String
Dim HostAppStr As String
On Error Resume Next
If Application.Name = "Microsoft PowerPoint" Then
HostAppStr = "FaceId.ppa!FaceIdExplorerModule."
ElseIf Application.Name = "Microsoft Excel" Then
HostAppStr = "FaceId.xla!FaceIdExplorerModule."
End If
CommandBars(SFaceIdCommandBarName).Delete
Set Toolbar = CommandBars.Add(Name:=SFaceIdCommandBarName, Temporary:=True)
With Toolbar
.RowIndex = Val(GetSetting(SAppName, SPreferencesSection, _
SRowIndexKey, "-1"))
.Position = Val(GetSetting(SAppName, SPreferencesSection, _
SPositionKey, Str(msoBarFloating)))
.Top = Val(GetSetting(SAppName, SPreferencesSection, _
STopKey, "100"))
.Left = Val(GetSetting(SAppName, SPreferencesSection, _
SLeftKey, "100"))
WidthStr = GetSetting(SAppName, SPreferencesSection, _
SWidthKey, "")
.Height = Val(GetSetting(SAppName, SPreferencesSection, _
SHeightKey, "100"))
StartFaceId = Val(GetSetting(SAppName, SPreferencesSection, _
SStartFaceIdKey, "1"))
If StartFaceId < FIRST_FACEID Then
StartFaceId = FIRST_FACEID
End If
.Protection = msoBarNoCustomize
End With
Set Button = Toolbar.Controls.Add(Type:=msoControlButton)
With Button
.Caption = " About... "
.Style = msoButtonCaption
.Tag = BUTTON_ABOUT
.BeginGroup = True
.TooltipText = "Show information about the author"
.OnAction = HostAppStr + "AboutFaceIdExplorer"
End With
Set Button = Toolbar.Controls.Add(Type:=msoControlButton)
With Button
.Caption = " « Previous "
.Style = msoButtonCaption
.Tag = BUTTON_PREVIOUS
.Enabled = False
.BeginGroup = True
.TooltipText = "Previous 100 FaceIds"
.OnAction = HostAppStr + "PreviousButtonClick"
End With
Set Button = Toolbar.Controls.Add(Type:=msoControlButton)
With Button
.Caption = " Next » "
.Style = msoButtonCaption
.Tag = BUTTON_NEXT
.TooltipText = "Next 100 FaceIds"
.OnAction = HostAppStr + "NextButtonClick"
End With
Begin = True
TotalWidth = 0
For i = 1 To 100
Set Button = Toolbar.Controls.Add(Type:=msoControlButton)
With Button
TotalWidth = TotalWidth + .Width + 2
.Tag = BUTTON_FACEID
.BeginGroup = Begin
If Begin Then
Begin = False
End If
End With
Next
With Toolbar
.Visible = False
If Not (WidthStr = "") Then
.Width = Val(WidthStr)
Else
.Width = TotalWidth / 10
End If
.Visible = Val(GetSetting(SAppName, SPreferencesSection, _
SVisibilityKey, "1"))
End With
End Sub
Sub AssignFaceId()
Dim Toolbar As CommandBar
Dim Button As CommandBarButton
Dim i As Integer
On Error Resume Next
Set Toolbar = CommandBars(SFaceIdCommandBarName)
i = StartFaceId
For Each Button In Toolbar.Controls
With Button
If .Tag = BUTTON_FACEID Then
.FaceId = i
.TooltipText = "FaceId: " + Str(i)
i = i + 1
End If
End With
Next
End Sub
Sub SetPreviousButtonState()
Dim Toolbar As CommandBar
Dim Button As CommandBarButton
On Error Resume Next
Set Toolbar = CommandBars(SFaceIdCommandBarName)
For Each Button In Toolbar.Controls
With Button
If .Tag = BUTTON_PREVIOUS Then
If StartFaceId = FIRST_FACEID Then
.Enabled = False
Else
.Enabled = True
End If
Exit For
End If
End With
Next
End Sub
Sub PreviousButtonClick()
StartFaceId = StartFaceId - 100
If StartFaceId < FIRST_FACEID Then
StartFaceId = FIRST_FACEID
End If
SetPreviousButtonState
AssignFaceId
End Sub
Sub NextButtonClick()
StartFaceId = StartFaceId + 100
SetPreviousButtonState
AssignFaceId
End Sub
Explore CommandBar control FaceIds Provided by Microsoft
Leave a Comment
You must be logged in to post a comment.