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

'Define o evento que estamos buscando. Neste caso, queremos o

'evento para o Command CommandBarComboBox. O nome do evento,

'você pode escolher. Neste exemplo, estarei chamando de

'"eventosCboBox"

Private WithEvents eventosCboBox As Office.CommandBarComboBox

'Instancia o evento eventosCboBox no controle "box"

'do Office.CommandBarComboBox

Public Sub iniciarCtrl(box As Office.CommandBarComboBox)

    Set eventosCboBox = box

End Sub

Private Sub eventosCboBox_Change(ByVal Ctrl As Office.CommandBarComboBox)

'   Dimensiona a conexão e o recordset

    Dim cn      As ADODB.Connection

    Dim rs      As ADODB.Recordset

'   Instancia os objetos cn e rs

    Set cn = CurrentProject.Connection

    Set rs = CreateObject("ADODB.Recordset")

'   Definição da string SQL

    SQL = "SELECT * FROM itensCboBox WHERE descrItem ='" & Ctrl.Text & "'"

'   Abre o recordset

    rs.Open SQL, cn, 1

'   Pega o "tipo"

    tipo = rs![tipo]

'   Seleciona o caso do tipo

    Select Case tipo

'       Se o caso for "Tabela"

        Case "Tabela"

'           Perguntar ao usuário de deseja continuar

            resposta = MsgBox("A tabela selecionada será aberta para " _

             & "edição! Deseja continuar?", vbInformation + vbYesNo)

'           Se resposta negativa, terminar a execução

            If Not resposta = vbYes Then Exit Sub

'           Se a resposta for positiva, abrir a tabela em modo de design

            DoCmd.OpenTable Ctrl.Text, acViewDesign

'       Se o caso for "Form"

        Case "Form"

'           Perguntar ao usuário de deseja continuar

            resposta = MsgBox("O formulário selecionado será aberto " _

              & "para edição! Deseja continuar?", vbInformation + vbYesNo)

'           Se a resposta for negativa, terminar a execução

            If Not resposta = vbYes Then Exit Sub

'           Se resposta positiva, abrir o formulário em modo de design

            DoCmd.OpenForm Ctrl.Text, acViewDesign

'       Um outro caso qualquer não definido

        Case Else

            MsgBox "Caso desconhecido", vbInformation + vbOKOnly

    End Select

End Sub

'Instancia as duas contantes referentes ao nome

'da barra que conterá o menu e o menu

Public Const NOMEMENU       As String = "Menu Combobox"

Public Const BARRAACCESS    As String = "Database"

Dim selecaoCboBox As New clsEventos

Sub mnuCboBox()

'   Dimensiona os objetos de menu

    Dim cmdbar      As CommandBar

    Dim cboBox      As CommandBarControl

'   Dimensiona a conexão e o recordset

    Dim cn          As ADODB.Connection

    Dim rs          As ADODB.Recordset

'   Em caso de erro continuar execucao

    On Error Resume Next

'   Encontrar o controle...

    Set cboBox = CommandBars(BARRAACCESS).FindControl(Tag:=NOMEMENU)

'       ... e excluí-lo

        cboBox.Delete

'   Instancia os objetos cn e rs

    Set cn = CurrentProject.Connection

    Set rs = CreateObject("ADODB.Recordset")

'   Define a string SQL

    SQL = "SELECT * FROM itensCboBox"

'   Abre o recordset

    rs.Open SQL, cn, 1

'   Se nao for início dos registros, mover para o primeiro registro

    If Not rs.BOF Then rs.MoveFirst

'   Se for o final do arquivo, avisar o usuário

    If rs.EOF Then

        MsgBox "Não há itens para inserir na combobox! " _

          & "A rotina será terminada!", vbInformation + vbOKOnly

        Exit Sub

    End If

'   Instancia o cmdbar como sendo a BARRAACCESS

    Set cmdbar = CommandBars(BARRAACCESS)

'   Instancia o cboBox na BARRAACCESS

    Set cboBox = cmdbar.Controls.Add(Type:=msoControlComboBox)

'       Define o tag utilizado para exclusao do controle

        cboBox.Tag = NOMEMENU

'   Enquanto (While) nao for (Not) fim do arquivo (End of File - EOF)

    While (Not (rs.EOF))

'       Adicionar o item do campo descrItem

        cboBox.AddItem rs![descrItem]

        rs.MoveNext

    Wend

'   Primeiro item selecionado na caixa

    cboBox.ListIndex = 1

'   Iniciar a classe cointendo o controle do evento change

    selecaoCboBox.iniciarCtrl cboBox

    rs.Close

    cn.Close

    Set rs = Nothing

    Set cn = Nothing

End Sub