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

Figura 6‑7 Relacionamentos entre as tabelas da escola

Vejamos os campos de cada tabela e seus tipos de dados:

• tblAlunos

Figura 6‑8 Campos da tabela tblAlunos

• tblCursos

Figura 6‑9 Campos para a tblCursos

• tblCursoAluno:

Figura 6‑10 Campos da tabela tblCursoAluno (para relacionamento muitos-para-muitos)

• tblFormaPgto

Figura 6‑11 Campos da tabela tblFormaPgto

• tblPgto

Figura 6‑12 Campos para a tabela tblPgto

Com as tabelas devidamente criadas e os relacionamentos feitos, nós podemos criar um formulário com múltiplos subformulários utilizando o assistente de formulários.

Figura 6‑13 Formulário para aluno e respectivos subformulários

Na figura anterior, quando selecionamos um curso (veja seta ao lado do curso “Access Avançado”), os detalhes dos pagamentos para este curso são mostrados no subformulário logo abaixo:

Na figura acima, quando curso de “PowerPoint” é selecionado nenhuma informação de pagamento aparece, pois ainda não foram geradas as parcelas (note que o campo GerarParcela não foi marcado ainda). O nosso próximo objetivo é escrever o código que, ao marcarmos este campo, os dados referentes ao pagamento sejam inseridos.

OptionCompare Database

Sub Form_Current()

    Dim ParentDocName As String

    On Error Resume Next

    ParentDocName = Me.Parent.Name

    If Err <> 0 Then

        GoTo Form_Current_Exit

    Else

        On Error GoTo Form_Current_Err

        Me.Parent![tblPgto Subformulário].Requery

    End If

Form_Current_Exit:

    Exit Sub

Form_Current_Err:

    MsgBox Error$

    Resume Form_Current_Exit

EndSub

PrivateSub GerarParcelas__Click()

    Dim rs          As ADODB.Recordset

    Dim blnAtual    As Boolean

    Dim resposta

    blnAtual = Not (Me.GerarParcelas_.Value)

    If blnAtual = True Then

        resposta = MsgBox("Você realmente deseja remover as parcelas " _

            & "dos pagamentos gerados para este curso?" _

            & vbCr & vbCr & "Se você clicar 'sim', TODOS os registros das parcelas " _

            & "serão removidos incluindo informações de pagamentos já " _

            & "efetuados!", vbQuestion + vbYesNo)

        If resposta = vbYes Then

            Call removerParcelas(Me.IDCurso)

            Exit Sub

        Else:

            Me.GerarParcelas_.Value = True

            Exit Sub

        End If

    End If

    If Me.NomeDoCurso = 0 Or IsNull(Me.DataInicio) _

        Or IsNull(Me.DataTérmino) Or IsNull(Me.Custo) _

        Or IsNull(Me.NúmPgtos) Or (Me.FormaPgto = 0) Then

        MsgBox "Você precisa preencher todos os campos antes de clicar nesta " _

            & "opção.", vbCritical

        Me.GerarParcelas_.Value = False

        Exit Sub

    End If

    Call adicionarParcelas(Me.IDCurso, Me.NúmPgtos, _

        Me.JurosMensais, Me.Custo, Me.DataInicio)

EndSub

PrivateSub adicionarParcelas(ByVal IDCurso As Long, _

    ByVal Parcelas As Integer, ByVal juros As Double, _

    ByVal valorCurso As Currency, ByVal dataInicial As Date)

    Dim db          As DAO.Database

    Dim rs          As DAO.Recordset

    OnError GoTo Err_Handler

    Me.Requery

    Set db = CurrentDb

    Set rs = db.OpenRecordset("tblPgto", dbOpenTable)

    For i = 1 To Parcelas

        With rs

            .AddNew

            .Fields("IDCurso") = IDCurso

            .Fields("Parcela") = CStr(i & "/" & Parcelas)

            .Fields("ValorParcela") = Round(Abs(Pmt(juros, Parcelas, valorCurso)), 2)

            .Fields("Vencimento") = DateSerial(Year(dataInicial), Month(dataInicial) + i, Day(dataInicial))

            .Update

        End With

    Next i

Sair:

    Set db = Nothing

    Set rs = Nothing

    Me.Requery

    Exit Sub

Err_Handler:

    MsgBox Err.Description, vbCritical, Err.Number

    Resume Sair

EndSub

PrivateSub removerParcelas(ByVal IDCurso As Long)

    Dim db          As DAO.Database

    Dim qryDef      As DAO.QueryDef

    On Error GoTo Err_Handler

    Set db = CurrentDb

    Set qryDef = db.CreateQueryDef("qryRemover", _

        "Delete tblPgto.IDCurso FROM tblPgto WHERE tblPgto.IDCurso=" & IDCurso)

    qryDef.Execute

    db.QueryDefs.Delete "qryRemover"

Sair:

    Set db = Nothing

    Set qryDef = Nothing

    Me.Requery

    Exit Sub

Err_Handler:

    MsgBox Err.Description, vbCritical, Err.Number

    Resume Sair

EndSub

Basta agora clicar no botão de inserção das prestações que o cálculo será feito diretamente e inserido na tabela de controle de pagamentos.

Caso os dados já tenham sido calculados e o campo já esteja marcado, mas o usuário clique por engano sobre o botão uma mensagem de aviso é mostrada:

Figura 6‑14 Aviso de remoção

Caso o usuário confirme a exclusão todas as informações de pagamento serão removidas.

Modelando dados para pesquisas de opinião

O objetivo deste tópico é criar uma pesquisa para resposta diretamente no Access. Tal pesquisa foi criada em cima de um desafio do fórum onde diversos participantes postaram soluções diferentes para o mesmo problema.

Aqui, apresento a minha resposta ao problema original a qual pode ser comparada com os exemplos do link. Acredito que a comparação seja importante, pois ela dá ao leitor uma idéia de como um mesmo problema pode ser resolvido de formas diferentes.

Pesquisa interna: entrevistando e tabulando diretamente no Access

Este exemplo de pesquisa interna pode ser utilizado em vários cenários como pesquisas online utilizando ASP.

O objetivo desta pesquisa é delineado abaixo:

• tblOpcoes à Tabela utilizada para armazenar a opção de cada pergunta;
• tblPerguntas à Tabela utilizada para armazenar cada pergunta da pesquisa;
• tblPesquisa à Tabela para armazenar cada pesquisa;
• tblPesquisaRespondentes à Tabela para armazenar o respondente e respectiva pesquisa da qual tenha participado;
• tblRespondentes à Tabela para armazenar os detalhes dos respondentes;
• tblRespostas à Tabulação das respostas às opções.

Para termos uma melhor noção de como os dados se relacionarão, vejamos o resultado do relacionamento entre tabelas:

Figura 6‑15 Relacionamento entre as tabelas da pesquisa

O leitor e capaz de identificar as relações?

Como estamos tratando de uma pesquisa, a tabela de pesquisa será a mais importante neste exemplo. Note que ela se ramifica em duas direções. A primeira direção refere-se às perguntas e a segunda refere-se aos respondentes.

O leitor deve notar também que a tabela tblPesquisaRespondentes possui um relacionamento muitos-para-muitos (note o símbolo de infinito saindo em ambos os lados). Isso implica que ela pode conter várias vezes a mesma pesquisa e várias vezes o mesmo respondente.

Isso é importante porque podemos ter várias pesquisas, ao passo que um pesquisado pode participar de várias pesquisas. Esta tabela é a que reconciliar isso tudo.

As outras tabelas possuem uma relação de um-para-muitos.

Vejamos a estrutura de cada tabela iniciando pela tabela que armazena o nome da pesquisa seguida pelas tabelas que armazenam as questões da pesquisa, respectivas opções e armazenamento dos resultados:

• tblPesquisa
• IDPesquisa à Refere-se ao número de identificação da pesquisa;
• NomePesquisa à Refere-se ao texto do nome da pesquisa que será feita.
• tblPergunta
• IDPergunta à Refere-se ao número de identificação da pergunta;
• IDPesquisa à Refere-se ao número da pesquisa. Este campo é utilizado para o relacionamento com a tabela tblPesquisa;
• Pergunta à Refere-se ao texto da pergunta.
• tblOpcoes
• IDOpcao à Refere-se ao número de identificação da opção da pergunta;
• IDPergunta à Refere-se ao número da pergunta. Este campo é utilizado para o relacionamento com a tabela tblPergunta.
• Opção à Refere-se ao texto da opção da pergunta.
• tblPesquisaRespondente
• ID à Refere-se ao número serial de identificação dos registros. Este número não será utilizado para nenhum controle a não ser o da própria tabela;
• IDPesquisa à Número de identificação da pesquisa. Serve para controlar a pesquisa respondida casada com o respondente. Este campo é relacionado ao campo IDPesquisa na tabela tblPesquisa;
• IDRespondente à Número de identificação do respondente. Serve para controlar o respondente casado com a pesquisa. Este campo é relacionado ao campo IDRespondente na tabela tblRespondentes
• tblRespondentes
• IDRespondente à Refere-se ao número de identificação do respondente;
• Nome à Refere-se ao texto do nome do respondente;
• Telefone à Refere-se ao texto do telefone do respondente;
• Endereço à Refere-se ao texto do endereço do respondente;
• CEPà Refere-se ao texto do CEP do respondente;

Agora que já possuímos todas as tabelas e campos, o leitor pode efetuar o relacionamento entre os campos conforme figura já mostrada. Feito isso nós estamos prontos para entrar as informações da pesquisa.

O leitor deve estudar as imagens a seguir para compreender como as informações fluem entre as tabelas relacionadas.

Iniciaremos pela tabela principal (a tabela que armazena a pesquisa):

Figura 6‑16 Pesquisa e respectivas perguntas

Na figura acima, foram adicionadas duas pesquisas. A primeira pesquisa possui 10 questões ao passo que a segunda pesquisa possui apenas 1. Na linha onde aparece o (*) podemos digitar algo para adicionar mais uma pergunta. Neste exemplo, nos limitaremos a 10 perguntas (devido ao formato do formulário). Podemos expandir uma pergunta para adicionar/editar/visualizar as opções de resposta para a pergunta:

Figura 6‑17 Perguntas e respectivas opções de resposta

Na figura acima, vemos as opções de resposta para determinada pergunta. Podemos editar, adicionar, remover, etc, opções de perguntas nesta janela.

Finalmente, nós temos as respostas:

Figura 6‑18 Opções de respostas e respectivas respostas

No caso da tabela de respostas, temos dois cenários:

• Contagem individual;
• Contagem cumulativa.

O primeiro tipo de contagem é a que ocorre no exemplo desenvolvido, isto é para IDOpcao (valor indexado e único) existirá um número “infinito” de respostas. No exemplo acima, temos que a opção “Em uso” foi respondida três vezes. A tabulação e contagem dos dados ocorre em uma consulta ao invés de diretamente na tabela.

Já a contagem cumulativa mostraria o resultado diretamente na tabela, evitando a adição de registros de resposta. Deste modo, ao invés de termo “n-registros” (onde “n” é um número qualquer e no exemplo acima ele é igual a 3 – três respostas) teríamos uma acumulação em um registro único representado pelo IDResposta o qual é casado com o IDOpcao. Este tipo de contagem requer uma instrução SQL de atualização, pois não há adição de registros novos.

Neste exemplo, optei por utilizar uma contagem individual para facilitar a solução.

Com isso terminamos o nódulo iniciado na tabela de pesquisa. Podemos agora abrir a tabela de respondentes para verificar em quais pesquisas os respondentes registrados no banco de dados participaram:

Figura 6‑19 Respondentes e respectivas pesquisas

Finalmente, precisamos construir o formulário onde a pesquisa deve ser respondida:

Figura 6‑20 Formulário representando o questionário

Aqui, nós teremos um máximo de 10 perguntas e respostas sendo as cinco primeiras de resposta única ao passo que as cinco últimas o respondente pode selecionar mais de uma opção conforme mostra a figura anterior.

Para criar o formulário, siga as instruções abaixo:

• Adicione um novo formulário;
• Ao formulário adicione um controle “multi guia” (MultiPage) com três guias (tabulações). Nomeei as tabulações como segue:
• Seus dados à Para esta guia (tabulação) adicione os seguintes controles:
• 5 caixas de texto;
• 6 rótulos;
• 2 botões.

Figura 6‑21 Disposição de controles para a primeira guia (tabulação)

• Escolha pesquisa à Para esta guia (tabulação) adicione os seguintes controles:
• 2 rótulos;
• 1 caixa de combinação.

Figura 6‑22 Disposição de controles para a segunda guia (tabulação)

• Responda a pesquisa à Para esta guia (tabulação) adicione os seguintes controles:
• 12 rótulos;
• 1 botão;
• 10 caixas de listagem

Figura 6‑23 Disposição de controles para a terceira guia (tabulação)

O leitor deve notar que os controles que receberão dados não estão acoplados.

Para as caixas de combinação na terceira guia (Responda a Pesquisa), o leitor deve modificar as seguintes propriedades:

• Para as cinco primeiras caixas de listagem determinar:
• número de coluna igual a 2;
• largura da coluna iguais a 0cm e 5cm;
• acoplamento na coluna 1
• nomes como sendo de lstP1 a lstP5 (o mesmo vale para os rótulos que acompanham cada caixa de listagem)
• Para as cinco últimas caixas de listagem determinar:
• número de coluna igual a 2;
• largura da coluna iguais a 0cm e 5cm;
• acoplamento na coluna 1
• seleção múltipla como “simples”;
• nomes como sendo de lstP6 a lstP10 (o mesmo vale para os rótulos que acompanham cada caixa de listagem)

Finalmente, nós devemos adicionar o código a seguir para cada um dos objetos determinados (todo o código irá dentro do formulário que criamos):

OptionCompare Database

OptionExplicit

Dim rs          As DAO.Recordset

Dim db          As DAO.Database

Dim strSQL      As String

PrivateSub cboPesquisa_Change()

    On Error GoTo Err_Handler

    Dim rsPerguntas     As DAO.Recordset

    Dim rsOpcoes        As DAO.Recordset

    Dim ctrl            As Control

    Dim ctrlPergunta    As Control

    Dim ctrlOpcoes      As Control

    Dim i               As Integer

    Call limparControles

    Set db = CurrentDb()

    strSQL = "SELECT * FROM tblPerguntas WHERE IDPesquisa=" & CLng(Me.cboPesquisa.Value)

    Set rsPerguntas = db.OpenRecordset(strSQL, dbOpenSnapshot)

    Me.lblUmaOpcao.Visible = True

    For i = 1 To 10

        If rsPerguntas.EOF Then Exit For

        If i > 5 Then Me.lblMaisOpcoes.Visible = True

        Set ctrlPergunta = Me.Controls("lblP" & i)

        Set ctrlOpcoes = Me.Controls("lstP" & i)

        With ctrlPergunta

            .Caption = "P" & i & ": " & rsPerguntas.Fields("Pergunta").Value

            .Visible = True

        End With

        strSQL = "SELECT IDOpcao, Opcao, IDPergunta,* FROM tblOpcoes "

        strSQL = strSQL & "WHERE IDPergunta= " & CLng(rsPerguntas.Fields("IDPergunta").Value)

        With ctrlOpcoes

            .RowSource = strSQL

            .Visible = True

        End With

        Me.cmdVotar.Visible = True

        rsPerguntas.MoveNext

    Next i

sair:

'   limparControles

    On Error Resume Next

    Set rsPerguntas = Nothing

    Set rsOpcoes = Nothing

    Set ctrl = Nothing

    Set ctrlPergunta = Nothing

    Set ctrlOpcoes = Nothing

ExitSub

Err_Handler:

    MsgBox "Um erro inesperado ocorreu. Reportar ao administrador " _

        & "a seguinte informacao:" & vbCr _

        & "Erro número: " & Err.Number & vbCr _

        & "Descricao do erro: " & Err.Description, _

        vbCritical, "Erro número: " & Err.Number

    Err.Clear

    GoTo sair

EndSub

PrivateSub cmdCadastrar_Click()

    Dim resposta

    On Error GoTo Err_Handler

    resposta = MsgBox("Voce está prestes a cadastrar tal informacao. " _

        & "Voce deseja realmente continuar?", vbQuestion + vbYesNo)

    If Not resposta = vbYes Then

        MsgBox "Operação cancelada.", vbInformation

        Exit Sub

    End If

    If IsNull(Me.Nome) Then

        MsgBox "Voce precisa digitar o seu nome antes de continuar!", vbCritical

        Me.Nome.SetFocus

        Exit Sub

    End If

    Set db = CurrentDb

    Set rs = db.OpenRecordset("tblRespondentes", dbOpenTable)

    With rs

        .AddNew

        .Fields("Nome") = CStr(Me.Nome)

        .Fields("Telefone") = CStr(Me.Telefone)

        .Fields("Endereco") = CStr(Me.Endereco)

        .Fields("CEP") = CStr(Me.CEP)

        .Update

    End With

    rs.MoveLast

    Me.IDRespondente = rs.Fields("IDRespondente")

sair:

OnError Resume Next

IfNot rs Is Nothing Then

    rs.Close

    db.Close

    Set rs = Nothing

    Set db = Nothing

EndIf

ExitSub

Err_Handler:

    MsgBox "Um erro inesperado ocorreu. Reportar ao administrador " _

        & "a seguinte informacao:" & vbCr _

        & "Erro número: " & Err.Number & vbCr _

        & "Descricao do erro: " & Err.Description, _

        vbCritical, "Erro número: " & Err.Number

    Err.Clear

    GoTo sair

EndSub

PrivateSub cmdProcurarNome_Click()

    On Error GoTo Err_Handler

    Set db = CurrentDb

    strSQL = "SELECT * FROM tblRespondentes WHERE IDRespondente = " & CLng(Me.IDRespondente)

    Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)

    With rs

        Me.Nome = .Fields("Nome")

        Me.Telefone = .Fields("Telefone")

        Me.Endereco = .Fields("Endereco")

        Me.CEP = .Fields("CEP")

    End With

sair:

OnError Resume Next

IfNot rs Is Nothing Then

    rs.Close

    db.Close

    strSQL = ""

    Set rs = Nothing

    Set db = Nothing

EndIf

ExitSub

Err_Handler:

    MsgBox "Um erro inesperado ocorreu. Reportar ao administrador " _

        & "a seguinte informacao:" & vbCr _

        & "Erro número: " & Err.Number & vbCr _

        & "Descricao do erro: " & Err.Description, _

        vbCritical, "Erro número: " & Err.Number

    Err.Clear

    GoTo sair

EndSub

PrivateSub cmdVotar_Click()

    Dim ctrl                As Control

    Dim P                   As String

    Dim rsPesqResp          As DAO.Recordset

    Dim rsRespostas         As DAO.Recordset

    Dim item                As Variant

    OnError GoTo Err_Handler

    If IsNull(Me.IDRespondente) Then

        MsgBox "Voce precisa entrar seu número de identificacao " _

            & "antes de continuar.", vbInformation

        Me.multiPage.Pages(0).SetFocus

        Me.IDRespondente.SetFocus

        Exit Sub

    End If

    For Each ctrl In Me.multiPage.Pages(2).Controls

        If TypeName(ctrl) = "Listbox" Then

            If ctrl.Visible = True Then

                If ctrl.ItemsSelected.Count < 1 Then

                    P = Right(ctrl.Name, Len(ctrl.Name) - 3)

                    MsgBox "Voce nao respondeu a pergunta número " & P _

                        & ". Por favor, responda a pergunta antes de " _

                        & "continuar.", vbInformation

                    Exit Sub

                End If

            End If

        End If

    Next

    strSQL = "SELECT  * FROM tblPesquisaRespondente WHERE IDPesquisa = " & CLng(Me.cboPesquisa.Value)

    strSQL = strSQL & " AND IDRespondente=" & CLng(Me.IDRespondente)

    On Error Resume Next

    Set db = CurrentDb()

    Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)

    If rs.RecordCount = 1 Then

        MsgBox "Voce já votou neste pesquisa. Somente é possível " _

& "votar uma vez", _

            vbInformation

            limparControles

        GoTo sair

    End If

    Set rsPesqResp = db.OpenRecordset("tblPesquisaRespondente", dbOpenTable)

    With rsPesqResp

        .AddNew

        .Fields("IDPesquisa") = CLng(Me.cboPesquisa.Value)

        .Fields("IDRespondente") = CLng(Me.IDRespondente.Value)

        .Update

    End With

    Set rsRespostas = db.OpenRecordset("tblRespostas", dbOpenTable)

    For Each ctrl In Me.multiPage.Pages(2).Controls

        If TypeName(ctrl) = "Listbox" Then

            For Each item In ctrl.ItemsSelected

                With rsRespostas

                    .AddNew

                    .Fields("IDOpcao").Value = CLng(ctrl.ItemData(item))

                    .Fields("Resposta").Value = 1

                    .Update

                End With

            Next

        End If

    Next

sair:

    On Error Resume Next

    rs.Close

    rsPesqResp.Close

    rsRespostas.Close

    db.Close

    Set rs = Nothing

    Set rsRespostas = Nothing

    Set rsPesqResp = Nothing

    Set db = Nothing

    Exit Sub

Err_Handler:

    MsgBox "Um erro inesperado ocorreu. Reportar ao administrador " _

        & "a seguinte informacao:" & vbCr _

        & "Erro número: " & Err.Number & vbCr _

        & "Descricao do erro: " & Err.Description, _

        vbCritical, "Erro número: " & Err.Number

    Err.Clear

    GoTo sair

EndSub

PrivateSub limparControles()

    Dim ctrl    As Control

    For Each ctrl In Me.multiPage.Pages(2).Controls

        ctrl.Visible = False

    Next

EndSub

PrivateSub Form_Load()

    limparControles

EndSub