Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

CommandBar button FaceIds

Access Environment

CommandBar button FaceIds

by  bradles  Posted    (Edited  )
There's a few methods out there for this, but I needed a way to view the button faces available in a way that was easy to navigate and didn't take up the whole screen.

This displays 100 buttons at a time and has navigation buttons to show the previous or next set. The FaceId property is set as the tooltip and overall it's nice and compact on the screen.

Instructions: Paste the following code into a new module, and fire up using the ShowFaceIds sub.

Thanks to Tek-Tips and everyone contributing, I've learned as much here as anywhere else and I felt compelled to give something (perhaps meagre) back.

Code: 
Option Compare Database
Option Explicit

Const cBarName = "FaceIds"

Private iFirstIcon As Integer

Public Sub ShowFaceIds()
    iFirstIcon = 0
    InitBar
    SetBar
End Sub

Private Sub InitBar()
    Dim CBR As CommandBar
    Dim cmdNext As CommandBarButton
    Dim cmdPrevious As CommandBarButton
    Dim cmdRange As CommandBarButton
    
    If CBRExists(cBarName) = True Then
        CommandBars(cBarName).Delete
    End If
    
    Set CBR = CommandBars.Add(cBarName)
    CBR.Position = msoBarFloating
    
    Set cmdPrevious = CBR.Controls.Add
    cmdPrevious.Caption = "<<Previous"
    cmdPrevious.OnAction = "=FaceIdPrevious()"
    cmdPrevious.Style = msoButtonCaption
    cmdPrevious.Width = 80
    
    Set cmdRange = CBR.Controls.Add
    cmdRange.Style = msoButtonCaption
    
    Set cmdNext = CBR.Controls.Add
    cmdNext.Caption = "Next>>"
    cmdNext.OnAction = "=FaceIdNext()"
    cmdNext.Style = msoButtonCaption
    cmdNext.Width = 80
    
    CBR.Visible = True
    
    Set CBR = Nothing
    Set cmdNext = Nothing
    Set cmdPrevious = Nothing
    Set cmdRange = Nothing
End Sub

Private Sub SetBar()
    Dim CBR As CommandBar
    Dim CBC As CommandBarButton
    Dim I As Integer
    
    If iFirstIcon = 0 Then iFirstIcon = 1
    Set CBR = CommandBars(cBarName)
    
    'Remove all buttons
'    For I = CBR.Controls.Count To 4 Step -1
'        CBR.Controls(I).Delete
'    Next
    
    'Set new buttons
    For I = iFirstIcon To iFirstIcon + 100
        If CBR.Controls.Count < 104 Then
            Set CBC = CBR.Controls.Add
        Else
            Set CBC = CBR.Controls(I - iFirstIcon + 4)
        End If
        CBC.Style = msoButtonIcon
        CBC.Caption = I
        CBC.FaceId = I
        CBC.TooltipText = I
        CBC.Visible = True
    Next
    SetRangeButton iFirstIcon & "-" & iFirstIcon + 100
    CBR.Height = CBC.Height * 10
    CBR.Width = CBC.Width * 10
    CBR.Visible = True
    
    Set CBC = Nothing
    Set CBR = Nothing
End Sub

Private Function CBRExists(sName As String) As Boolean
    Dim CBR As CommandBar
    On Error Resume Next
    Set CBR = CommandBars(sName)
    If Err.Number <> 0 Then
        Err.Clear
        CBRExists = False
    Else
        Set CBR = Nothing
        CBRExists = True
    End If
    Set CBR = Nothing
End Function

Public Function FaceIdNext()
    iFirstIcon = iFirstIcon + 100
    EnablePreviousButton True
    SetBar
End Function

Public Function FaceIdPrevious()
    iFirstIcon = iFirstIcon - 100
    If iFirstIcon > 0 Then
        SetBar
    Else
        EnablePreviousButton False
    End If
End Function

Private Sub SetRangeButton(sCaption As String)
    CommandBars(cBarName).Controls(2).Caption = sCaption
End Sub

Private Sub EnablePreviousButton(bEnable As Boolean)
    CommandBars(cBarName).Controls(1).Enabled = bEnable
End Sub

Private Sub EnableNextButton(bEnable As Boolean)
    CommandBars(cBarName).Controls(3).Enabled = bEnable
End Sub

Brad Stevens
4th November 2005
Register to add this FAQ to your archive
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top