Júlio Battisti Livros e Cursosa sua sala de aula na internet

Private Sub Form_Load()

'   Chama a rotina para criação dos menus

    Call mnu

'   Fecha o formulário

    DoCmd.Close acForm, "loadfrm"

End Sub

Sub mnu()

'   Dimensão dos objetos do menu

    Dim cmdBar  As CommandBar

    Dim popu   As CommandBarPopup

    Dim btn     As CommandBarButton

'   Dimensão dos objetos do banco de dados

    Dim cn      As Object

    Dim rs      As Recordset

    Dim Sql     As String

'   Define a conexão como sendo a conexão do projeto atual

    Set cn = Application.CurrentProject.Connection

'   Instrução SQL

    Sql = "SELECT * FROM [ItensMenu]"
   

'   Define o recordset

    Set rs = CreateObject("ADODB.Recordset")

'   Abre o recordset utilizando a instrução SQL e conexão acima

    rs.Open Sql, cn, 1

'   Em caso de erro, continuar a execução do código

    On Error Resume Next

'   Remove o menu anterior caso ele exista

    CommandBars(NOMEMENU).Delete

'   Se final do arquivo (End of File - EOF)

    If (rs.EOF) Then

'   Avisar que não há itens de menu na tabela

        MsgBox "Não há itens para acrescentar ao menu!", vbInformation

'   Se houver..

    Else

'   Cria a barra de comando/ferramenta como sendo um MenuBar

    Set cmdBar = Application.CommandBars.Add _

        (Name:=NOMEMENU, MenuBar:=True)

'       Enquanto não o final do arquivo

        While (Not (rs.EOF))

'       Define o caso do Tipo

        Tipo = rs![Tipo]

'       Seleciona o caso

        Select Case Tipo

            Case 1 'Caso 1: menu popup

                Set popup = cmdBar.Controls.Add(Type:=msoControlPopup)

                With popup

                    .Caption = rs![Caption]

                    .Width = rs![Width]

                End With

            Case 2 'Caso 2: botão

                Set btn = popup.Controls.Add(Type:=msoControlButton)

                With btn

                    .BeginGroup = rs![BeginGroup]

                    .Caption = rs![Caption]

                    .FaceId = rs![FaceId]

                    .OnAction = rs![OnAction]

                    .State = rs![State]

                    .Width = rs![Width]

                End With

        End Select

        rs.MoveNext

        Wend

    End If

'   Mostrar menu

    cmdBar.Visible = True

'   Proteger o menu

    cmdBar.Protection = msoBarNoCustomize + msoBarNoMove

'   Fecha o recordset

    rs.Close

'   Limpa o recordset da memória

    Set rs = Nothing

'   Limpa a conexão da memória

    Set cn = Nothing

End Sub

Sub sair()

'   Pergunta ao usuário se deseja realmente sair

    resposta = MsgBox("Você tem certeza que deseja terminar está sessão?", vbQuestion + vbYesNo, "Terminar sessão")

'   Se a resposta for negativa, então sair desta rotina

    If Not resposta = vbYes Then Exit Sub

'   Remove o menu criado

    CommandBars(NOMEMENU).Delete

'   Reabilita e reinicia o menu padrão do Access

    CommandBars(MENUACCESS).Enabled = True

    CommandBars(MENUACCESS).Reset

'   Fecha o projeto atual, mas permanece no Access

    Application.CloseCurrentDatabase

'   Remova o comentário da linha abaixo para fechar o Access também

'   Application.Quit

End Sub