Function offering: a way of automatically assigning faceid's to buttons

[kelly d via AccessMonster.com]

This isnt a question. this is just a code offering for a function I made for
an issue I had in case anybody else wants it to. It's a function that 1st
creates a toolbar with a popup that has all 1708 faceID's available in office.
then it allows you to click on a faceID which will bring up a popup of all
the commandbars in your app which is the method for choosing which commandbar
you want to change the faceID of a button on, clicking an option in that list
will popup another menu that has all the controls in the commandbar you chose.
clicking the name of a control will change the faceID of the button you chose
to the faceID you chose in the 1st menu.
created in Access2002

begin code: (copy and paste to new module)

Function AddMenuButtonFaces(Optional face As Integer, Optional menu As String,
Optional ctl As String)
Dim a As CommandBar, b As CommandBar, x As CommandBarPopup, y As
CommandBarControl
Dim z as CommandBarControl

On Error Resume Next

If face <> 0 Then
If Nz(menu, "") <> "" Then
If Nz(ctl, "") <> "" Then
CommandBars(menu).Controls(ctl).FaceId = face
CommandBars(menu).Controls(ctl).Style = 0
CommandBars("TempCtlMenu").Delete

Else 'ctl is blank create and show ctl menu

Set a = CommandBars("TempCtlMenu")
If a Is Nothing Then
err.Clear 'assigning a variable to a non-existant commandbar
generates an error
Set a = CommandBars.Add("TempCtlMenu", msoBarPopup, , True)

End If

For Each z In CommandBars(menu).Controls
Set y = a.Controls.Add(msoControlButton, , , , True)
y.Caption = z.Caption
y.OnAction = "=AddMenuButtonFaces(" & face & ",'" &
menu & "','" & z.Caption & "')"
Next z
CommandBars("TempMenuMenu").Delete
a.ShowPopup

End If
Else 'menu is blank create and show menu menu

Set a = CommandBars("TempMenuMenu")
If a Is Nothing = True Then
err.Clear
Set a = CommandBars.Add("TempMenuMenu", msoBarPopup, , True)

End If

For Each b In CommandBars
Set y = a.Controls.Add(msoControlButton, , , , True)
y.Caption = b.Name
y.OnAction = "=AddMenuButtonFaces(" & face & ",'" & b.
Name & "')"
y.Style = 2
Next b
a.ShowPopup

End If

Else 'face was 0 so you must be running this function without parameters so
create the toolbar


Set a = Application.CommandBars("Button Faces")
Set x = a.Controls.Add(msoControlPopup)
x.Caption = "button faces"




For zz = 1 To 2000 'i think theres only 1708 but if there's more this
will catch them
Set y = Application.CommandBars("Button Faces").Controls(x.Caption).
Controls.Add & _ (Type:=msoControlButton)
With y
.FaceId = zz
.Caption = zz
.OnAction = "=AddMenuButtonFaces(" & zz & ")"
End With
Next zz

End If

End Function

 

[kelly d via AccessMonster.com]

I didnt realize that the 'post preview' screen was wider than the actual
posting screen. so if you use this code make sure to reattach the line
segments that the posting of the code broke in half.