View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Jeremy Gollehon[_2_] Jeremy Gollehon[_2_] is offline
external usenet poster
 
Posts: 35
Default FaceID Toolbar (The best one ever!)

OK, OK... I'm just messing around with the "The best one ever!" thing.
However, I spent some time tweaking my FaceID code to make it the best one
ever, for me. My reasons for messing with this at all (since there are MANY
FaceID toolbars out there) are simple.

1) I wanted the code to be as light as possible (if you have any
suggestions, I'd love to here them).
2) I browse available FaceID's, find one I like, keep browsing and forget if
the one I'm looking at now is better than the one I liked before.

The following code creates a toolbar that allows for quick and easy
navigation and an ID selection history.
See a screenshot of the result looks he
http://snipurl.com/FaceID

Feel free to use and/or modify this code as you see fit. If you make any
changes that shorten the code at all, I'd love to see them.

-Jeremy


Regular code module:
--------------------------------------------------------------------------
Option Explicit
Option Private Module

Public Const Title As String = "ShowMe the FaceId"
Public IDToolbar As CommandBar
Public btnID(1 To 100) As New FaceIDClass

Sub ShowFaceIds()
Dim i As Long

'Reset toolbar
On Error Resume Next
Application.CommandBars(Title).Delete
Set IDToolbar = Application.CommandBars.Add(Title)
On Error GoTo 0

'Build toolbar
With IDToolbar.Controls

With .Add(msoControlButton) 'Previous button
.FaceId = 3825
.OnAction = "Prev_Click"
.Height = 30
End With

With .Add(msoControlButton) 'Next button
.FaceId = 3826
.OnAction = "Next_Click"
End With
.Add(msoControlButton).Width = 48 'Spacer

With .Add(msoControlButton) 'JumpTo label
.Style = msoButtonCaption
.Caption = "Viewing"
End With

With .Add(msoControlComboBox) 'JumpTo dropdown
.Caption = "JumpTo"
.OnAction = "JumpTo_Change"
For i = 1 To 4301 Step 100
.AddItem i & " to " & (i + 99)
Next i
.ListIndex = 1
End With

For i = 1 To 100 'FaceID buttons
Set btnID(i).btnFaceID = .Add(msoControlButton)
Next i

With .Add(msoControlButton) 'Clear Button
.Style = msoButtonCaption
.Caption = "Clear History"
.OnAction = "ClearHistory"
.Width = 92
End With
.Add(msoControlButton).Height = 30 'Spacer
.Add(msoControlButton).Width = 114 'Spacer

'Selection history buttons
For i = 1 To 4
.Add(msoControlButton).Height = 30
Next i

End With

'Show Toolbar
With IDToolbar
.Width = 253
.Left = (Application.Width - .Width) / 2
.Top = (Application.Height - .Height) / 2
Call JumpTo_Change
.Visible = True
End With

End Sub

Sub JumpTo_Change()
Dim IDRng As Double
Dim btnIdx As Long, i As Long

btnIdx = 6
IDRng = Val(IDToolbar.Controls(5).Text)
For i = IDRng To IDRng + 99
With IDToolbar.Controls(btnIdx)
.FaceId = i
.TooltipText = i
End With
btnIdx = btnIdx + 1
Next i

End Sub

Sub Next_Click()
With IDToolbar.Controls("JumpTo")
If .ListIndex = .ListCount Then
Beep
Exit Sub
End If
.ListIndex = .ListIndex + 1
End With
Call JumpTo_Change
End Sub

Sub Prev_Click()
With IDToolbar.Controls("JumpTo")
If .ListIndex = 1 Then
Beep
Exit Sub
End If
.ListIndex = .ListIndex - 1
End With
Call JumpTo_Change
End Sub

Private Sub ClearHistory()
Dim i As Long

For i = 107 To 112
With IDToolbar.Controls(i)
.FaceId = 1
.Caption = ""
End With
Next i

End Sub
--------------------------------------------------------------------------

Class module named FaceIDClass
--------------------------------------------------------------------------
Option Explicit

Public WithEvents btnFaceID As CommandBarButton

Private Sub btnFaceID_Click(ByVal Ctrl As Office.CommandBarButton, _
CancelDefault As Boolean)
Dim i As Long

With Application.CommandBars(Title)
For i = .Controls.Count To .Controls.Count - 5 Step -1
With .Controls(i)
.Style = msoButtonIconAndCaption
If i = 107 Then
.FaceId = Ctrl.FaceId
.Caption = Ctrl.FaceId
ElseIf i = 109 Then
.Caption = "" & .Parent.Controls(107).Caption
.FaceId = .Parent.Controls(107).FaceId
ElseIf i 109 Then
.Caption = "" & .Parent.Controls(i - 1).Caption
.FaceId = .Parent.Controls(i - 1).FaceId
End If
End With
Next i
.Controls(108).Width = 230 - (.Controls(106).Width + _
..Controls(107).Width)
End With

End Sub
--------------------------------------------------------------------------