Home Addins Tips VBA FAQ Utilities Licensing Disclaimer Privacy Policy Links

FaceId Explorer Source Code

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

' FaceId_AddinInstall
'
' Microsoft Excel calls FaceId_AddinInstall while loading the addin.
Sub FaceId_AddinInstall()
    AddinInitialize
End Sub

' FaceId_AddinUninstall
'
' Microsoft Excel calls FaceId_AddinUninstall while unloading the addin.
Sub FaceId_AddinUninstall()
    AddinShutdown
End Sub

' Auto_Open
'
' Microsoft PowerPoint calls Auto_Open while loading the addin.
Sub Auto_Open()
    AddinInitialize
End Sub

' Auto_Close
'
' Microsoft PowerPoint calls Auto_Close while unloading the addin.
Sub Auto_Close()
    AddinShutdown
End Sub

' AddinInitialize
'
' This is the actual initialization routine of the FaceId Explorer
' addin. The host application dependent addin initialize function
' calls this function.
Sub AddinInitialize()
    StartFaceId = FIRST_FACEID
    CreateToolBar
    SetPreviousButtonState
    AssignFaceId
End Sub

' AddinShutdown
'
' This is the actual uninitialization routine of the FaceId Explorer
' addin. The host application dependent addin uninitialize function
' calls this function.
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

' CreateToolbar
'
' Creates a temporary non-customizable toolbar (commandbar). The
' FaceId buttons are tagged with a special value. This allows us
' to distinguish them from other buttons on the toolbar.
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

' AssignFaceId
'
' Updates the FaceIds of each FaceId button of our temporary
' non-customizable toolbar. The starting FaceId index is
' obtained from StartFaceId.
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

' SetPreviousButtonState
'
' Enables or disables " « Previous " button appropriately. This button
' is disabled if we are at the beginning of the FaceId list. The
' beginning of the list is indicated by FIRST_FACEID variable.
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

' PreviousButtonClick
'
' When the "Previous" button is clicked, this function gets called.
' It decrements the starting FaceId by 100 (we display 100 FaceIds
' at a time) and updates the buttons.
Sub PreviousButtonClick()
    StartFaceId = StartFaceId - 100
    If StartFaceId < FIRST_FACEID Then
        StartFaceId = FIRST_FACEID
    End If

    SetPreviousButtonState
    AssignFaceId
End Sub

' NextButtonClick
'
' When the "Next" button is clicked, this function gets called.
' It increments the starting FaceId by 100 and updates the buttons.
Sub NextButtonClick()
    StartFaceId = StartFaceId + 100

    SetPreviousButtonState
    AssignFaceId
End Sub


Copyright © 2001-2008 OfficeOne. All rights reserved.