Gestión de Barras de Menú en Microsoft Access

Publicado el 07 diciembre 2011 por Alexborras @alexborras

En este sencillo ejemplo se muestra como administrar las visualización de Barras de Menú (CommandBar) en Microsoft Access desde un formulario que carga las barras definidas por el usuario y permite visualizarlas o ocultarlas según se quiera. Probado en Microsoft Access 2000 y 2003

Esta función es interesante en aplicaciones que tienen muchas barras de Menú y que es necesario ajustar las que se quieren visualizar a las necesidades de cada usuario.

Descargar Ejemplo

Código Fuente del formulario:

PLAIN TEXT Visual Basic: Option Compare Database
    Dim matcb(50) As String
    Dim cb As CommandBar
    Dim ind As Integer
Option Explicit
Private Sub cmdCancelar_Click()
    DoCmd.Close acForm, Me.Name
End Sub
Private Sub cmdRefrescar_Click()
    VisualizarBarrasDeMenu
End Sub
Private Sub Form_Load()
    VisualizarBarrasDeMenu
End Sub
Private Sub cmdAplicar_Click()
    On Error GoTo ErrorSub
    For ind = 0 To Lista.ListCount
        If matcb(ind) <> "" Then
            Set cb = Application.CommandBars(matcb(ind))
            cb.Visible = Lista.Selected(ind)
        End If
    Next
    MsgBox "Cambios aplicados, ahora la aplicación se cerrará. Vuelvala a abrir para actualizar las barras de Menú ", vbInformation, "Barras de Menú"
    DoCmd.Quit
    Exit Sub
ErrorSub:
    MsgBox Err.Description
End Sub
Public Sub VisualizarBarrasDeMenu()
    On Error GoTo ErrorSub
    Lista.Clear
    Erase matcb
    ind = 0
    For Each cb In Application.CommandBars
        If cb.BuiltIn = False Then ' Barras creadas por el usuario
            If cb.Type = msoBarTypeMenuBar Or cb.Type = msoBarTypeNormal Then ' Se descartan los menús contextutales
                Debug.Print cb.Type & " | " & cb.BuiltIn & " | " & cb.Name
                Lista.AddItem (cb.Name)
                Lista.Selected(ind) = cb.Visible
                matcb(ind) = cb.Name
                ind = ind + 1
            End If
        End If
    Next
    Set cb = Nothing
    Exit Sub
ErrorSub:
    MsgBox Err.Description
End Sub