FaceID Toolbar (The best one ever!)

  • Thread starter Jeremy Gollehon
  • Start date
J

Jeremy Gollehon

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 here:
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
--------------------------------------------------------------------------
 
D

Doug Glancy

Mine counts the number of faceids when it first starts up, so theoretically
compatible with future versions. Plus it has a favorites section, and a
variable speed scan mode, you can resize the palette on the fly, and look up
faceids by toolbar (again, the toolbars actually in your version of XL).

Only took me 3 months to write, but I learned a lot, and what else are long
winter night's good for?

Doug Glancy
 
J

Jeremy Gollehon

Hi keepitcool.

Your's is definitely cool, but a little heavy for me.
I don't have a need for the extraction of the pict/mask/merged bmp. Is that
for editing the icons?
The history and easy flipping between sections is the main reason for my
version.

Also, thanks for the heads up on the extra faceID's office 2003.

-Jeremy
 
J

Jeremy Gollehon

Wow Doug,
Have you made that thing publicly available? Sounds pretty impressive.

-Jeremy
 
K

keepitcool

changing the individual onactions to 1 central handler with a select
case on actioncontrol.parameter might shorten it by a few lines... <g>

Winter? you must live on the southern hemispere... summer's just
starting here

keepITcool, Amsterdam

< email : keepitcool chello nl (with @ and .) >
< homepage: http://members.chello.nl/keepitcool >
 
D

Doug Glancy

Jeremy,

I'd like to, but I have no web site and it's an add-in. I'd be happy to
send it to you though and see what you think.

Doug
 
J

Jeremy Gollehon

I'd love to check it out. Most interested in the "favorites" section.
Just take out the BLAMSPAM.
 
D

Doug Glancy

It's been done for a couple of months. I'm in beautiful Portland, OR. I
did learn about actioncontrol while writing it - through this fine newsgroup
of course.

Doug
 
J

Jeremy Gollehon

OK, here's an updated version that should future proof my toolbar against
further additions to the FaceID count.

Thanks to KeepITcool for pointing out the problem, and Doug Clancy for
pointing my brain in a logical direction on how to tackle the problem.

The code's slightly longer now though. :-(

-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
Dim iFaceCount As Long

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

'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 = 40 'Spacer

With .Add(msoControlButton) 'JumpTo label
.Style = msoButtonCaption
.Caption = "Viewing"
'Determine the number of available FaceID's
i = 4301
Do Until Err <> 0
.FaceId = i
i = i + 70
Loop
Do Until Err = 0
Err = 0
i = i - 1
.FaceId = i
Loop
iFaceCount = i
End With
On Error GoTo 0

With .Add(msoControlComboBox) 'JumpTo dropdown
.Caption = "JumpTo"
.OnAction = "JumpTo_Change"
For i = 1 To iFaceCount Step 100
.AddItem i & " to " & (i + 99)
Next i
.Width = 100
.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

BPToolPak.EndTimer

End Sub

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

On Error Resume Next
btnIdx = 6
IDRng = Val(IDToolbar.Controls(5).Text)
For i = IDRng To IDRng + 99
With IDToolbar.Controls(btnIdx)
.FaceId = i
.TooltipText = i
If Err <> 0 Then
.FaceId = 1
.TooltipText = "N/A"
End If
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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Using Excel 2007 with Excel 2003 template 1
CommandBar and Controls (how to create separate "Sets" of Controls) 4
ControlButton Size 1
Problem transferring VBA code w/ ProcOfLine & ProcBodyLine to VB.NET 0
How to figure out which right-click context menu is appearing whenclicking shape/picture 2
FaceID not available 4
info on faceid 3
Automation error with XLA addin, fails on commandbarbutton onaction 0

Top