MaximoAccess

Caro Usuário, não tire as suas duvidas nas Salas de Repositório, abra sempre um novo tópico relacionado, nas salas destinadas para o efeito, como Sala de Tabelas, Consultas, Formulários, Relatórios, Macros, Módulos e VBA.

Obrigado

Administração do MaximoAccess

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access

    MÓDULO VBA URGENTE AJUDEM

    Compartilhe

    Eduardopaulomartins
    Novato
    Novato

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 2
    Registrado : 30/05/2014

    MÓDULO VBA URGENTE AJUDEM

    Mensagem  Eduardopaulomartins em Seg 16 Jun 2014, 22:40

    Pessoal me ajudem por favor!!!

    Tenho uma 3 formulários que criei no vba. codifiquei somente 1 o formulário de água, os outros dois são os mesmos formulários (idênticos) são os de luz e telefone, o de agua cadastra tudo certinho na planilha agua, o de luz e telefone quero fazer eles fazer a mesma coisa do formulário agua, mas ai precisaria escrever os códigos tudo de novo. parece que usando um módulo e chamar ele para executar a função ia funcionar... ajudem me mestres do vba sql
    porém quero criar um módulo para os outros 2 que façam eles funcionar, evitando assim escrever tudo de novos os códigos.


    me ajudem por favor!!! alien

    Segue abaixo a codificação que quero usar em MÓDULO:

    Dim BANCO As Database
    Dim TABELA As Recordset
    'PRIMEIRO declara GERAL variavel BANCO E TABELA
    'SEGUNDO CLICA NO USERFORM E COLOCA INITIALIZE E SET BANCO
    'TERCEIRO EXECUTA O BANCO COMANDO INSERT INTO


    Private Sub Command_excluiragua_Click()
    'CÓDIGO PARA TORNAR OBRIGATÓRIO A SELEÇÃO DE UMA REFERÊNCIA VÁLIDA

    If Me.Text_pesquisaragua <> "" Then

    Else

    MsgBox "SELECIONE UMA REFERÊNCIA VÁLIDA", vbExclamation
    Exit Sub
    End If


    'CÓDIGO PARA EXCLUIR LINHA NA PLANILHA SELECIONADA ATRAVÉS DO CÓDIGO
    Dim LINHA As String
    LINHA = "1"
    Do While Plan4.Range("E" & LINHA) <> Me.Text_numerocontaagua
    LINHA = LINHA + 1
    Loop

    Y = LINHA

    Plan4.Range("A" & Y).EntireRow.Delete





    MsgBox "DADOS EXCLUIDOS COM SUCESSO"
    'CÓDIGO PARA LIMPAR CAMPOS DOS TEXTBOX
    Me.Text_consumoagua = ""
    Me.Text_datapagamentoagua = ""
    Me.ComboBox_mes = ""
    Me.Text_numerocontaagua = ""
    Me.Text_pesquisaragua = ""
    Me.ComboBoxstatus = ""
    Me.Text_valoragua = ""
    Me.Text_vencimentoagua = ""
    Me.ComboBoxano = ""

    'ALÉM DE INSERIR ESSE CÓDIGO DENTRO DO USERFORM TBM TEM QUE COLOCAR AQUI PARA ELE CONTAR CASO VENHA DELETA-LO
    'Mostrar a quantidade de registros que há em todo banco de dados:

    Set TABELA = BANCO.OpenRecordset("SELECT COUNT (VALOR) AS CONTAR FROM [AGUA$];")
    Me.TextBoxregistros = TABELA("CONTAR")

    'INSERI UM IF CASO A CÉLULA A1 ESTEJA VAZIA PARA CONTAR 0 PQ NO CÓDIGO ACIMA MESMO EXCLUINDO TODOS AINDA FICA O NÚMERO 1

    If Range("A1") = "" Then
    Me.TextBoxregistros = 0
    End If

    End Sub

    Private Sub Command_limparagua_Click()

    'CÓDIGO PARA LIMPAR CAMPOS DOS TEXTBOX
    Me.Text_consumoagua = ""
    Me.Text_datapagamentoagua = ""
    Me.ComboBox_mes = ""
    Me.Text_numerocontaagua = ""
    Me.Text_pesquisaragua = ""
    Me.ComboBoxstatus = ""
    Me.Text_valoragua = ""
    Me.Text_vencimentoagua = ""
    Me.ComboBoxano = ""
    Me.ComboBoxstatus = ""

    End Sub

    Private Sub Command_pagar_Click()
    col = 5
           lin = 2
           While (Plan4.Cells(lin, col) <> Me.Text_numerocontaagua)
               lin = lin + 1
               If lin > 5000 Then
                   MsgBox "IMPOSSÍVEL ALTERAR O CAMPO NÚMERO DA CONTA", vbInformation
                   Exit Sub
               End If
    Wend


    col = 4
           lin = 2
           While (Plan4.Cells(lin, col) <> Me.Text_valoragua)
               lin = lin + 1
               If lin > 5000 Then
                   MsgBox "IMPOSSÍVEL ALTERAR O CAMPO VALOR", vbInformation
                   Exit Sub
               End If
    Wend

    col = 3
           lin = 2
           While (Plan4.Cells(lin, col) <> Me.Text_vencimentoagua)
               lin = lin + 1
               If lin > 5000 Then
                   MsgBox "IMPOSSÍVEL ALTERAR O CAMPO VENCIMENTO", vbInformation
                   Exit Sub
               End If
    Wend


    col = 2
           lin = 2
           While (Plan4.Cells(lin, col) <> Me.ComboBox_mes)
               lin = lin + 1
               If lin > 5000 Then
                   MsgBox "IMPOSSÍVEL ALTERAR O CAMPO MÊS DE REFERÊNCIA", vbInformation
                   Exit Sub
               End If
    Wend


    col = 6
           lin = 2
           While (Plan4.Cells(lin, col) <> Me.Text_consumoagua)
               lin = lin + 1
               If lin > 5000 Then
                   MsgBox "IMPOSSÍVEL ALTERAR O CAMPO CONSUMO", vbInformation
                   Exit Sub
               End If
    Wend


    col = 9
           lin = 2
           While (Plan4.Cells(lin, col) <> Me.ComboBoxano)
               lin = lin + 1
               If lin > 5000 Then
                   MsgBox "IMPOSSÍVEL ALTERAR O CAMPO ANO", vbInformation
                   Exit Sub
               End If
    Wend

    If Me.Text_numerocontaagua = "" Then

    MsgBox "INSIRA UMA CONTA CADASTRADA PARA PAGAMENTO", vbExclamation
    Exit Sub
    End If

    'MENSAGEM SE CONFIRMAR SIM OU NÃO

    Dim resultado As VbMsgBoxResult
        resultado = MsgBox("DESEJA CONTINUAR COM ESSA AÇÃO?", vbYesNo, "Tomando uma decisão")
        If resultado = vbYes Then
             MsgBox "PAGAMENTO REALIZADO COM SUCESSO"
        Else
            Me.Text_datapagamentoagua = ""
            Me.ComboBoxstatus = ""
            MsgBox "PAGAMENTO CANCELADO", vbCritical
        End If

    'CÓDIGO PARA INSERIR E ATUALIZAR OS CAMPOS CONFORME ESTIPULADO ABAIXO

    Sql = "UPDATE  [AGUA$] SET NÚMERO_CONTA = '" & Me.Text_numerocontaagua & "', MÊS_REFERÊNCIA = '" & Me.ComboBox_mes & "', VENCIMENTO = '" & Me.Text_vencimentoagua & "' , VALOR = '" & Me.Text_valoragua & "' , CONSUMO = '" & Me.Text_consumoagua & "', STATUS = '" & Me.ComboBoxstatus & "', PAGAMENTO = '" & Me.Text_datapagamentoagua & "', ANO = '" & Me.ComboBoxano & "'where NÚMERO_CONTA = '" & Me.Text_numerocontaagua & "';"
    BANCO.Execute Sql

    If Me.Text_datapagamentoagua <> "" Then
    Sql = "insert into [AGUA$] (PAGAMENTO) VALUES (PAGAMENTO = '" & Me.Text_datapagamentoagua & "' where MÊS_REFERÊNCIA = '" & Me.ComboBox_mes & "';"

    Else

    MsgBox "CAMPO DATA DE PAGAMENTO OBRIGATÓRIO", vbInformation
    Exit Sub
    End If

        'CÓDIGO LIMPAR CAMPOS
    Me.Text_consumoagua = ""
    Me.Text_datapagamentoagua = ""
    Me.ComboBox_mes = ""
    Me.Text_numerocontaagua = ""
    Me.Text_pesquisaragua = ""
    Me.ComboBoxstatus = ""
    Me.Text_valoragua = ""
    Me.Text_vencimentoagua = ""
    Me.ComboBoxano = ""
    Me.ComboBoxstatus = ""

    End Sub

    'CÓDIGO PARA TORNAR OBRIGATÓRIO PREENCHIMENTO DE CAMPOS EM BRANCO

    Private Sub CommandButton1_Click()


    If Me.Text_numerocontaagua <> "" Then
    Sql = "insert into [AGUA$] (VALOR, CONSUMO, STATUS, PAGAMENTO, MÊS_REFERÊNCIA, VENCIMENTO, NÚMERO_CONTA) VALUES ('" & Me.ComboBox_mes & "', VENCIMENTO = '" & Me.Text_vencimentoagua & "' , VALOR = '" & Me.Text_valoragua & "' , NÚMERO_CONTA = '" & Me.Text_numerocontaagua & "', CONSUMO = '" & Me.Text_consumoagua & "', STATUS = '" & Me.ComboBoxstatus & "', PAGAMENTO = '" & Me.Text_datapagamentoagua & "' where MÊS_REFERÊNCIA = '" & Me.ComboBox_mes & "';"

    Else

    MsgBox "PARA ATUALIZAR, CLICK NO CAMPO PESQUISAR MÊS E DIGITE UMA REFERÊNCIA VÁLIDA", vbInformation
    Exit Sub
    End If

    If Me.ComboBox_mes <> "" Then
    Sql = "insert into [AGUA$] (VALOR, CONSUMO, STATUS, PAGAMENTO, MÊS_REFERÊNCIA, VENCIMENTO, NÚMERO_CONTA) VALUES ('" & Me.ComboBox_mes & "', VENCIMENTO = '" & Me.Text_vencimentoagua & "' , VALOR = '" & Me.Text_valoragua & "' , NÚMERO_CONTA = '" & Me.Text_numerocontaagua & "', CONSUMO = '" & Me.Text_consumoagua & "', STATUS = '" & Me.ComboBoxstatus & "', PAGAMENTO = '" & Me.Text_datapagamentoagua & "' where MÊS_REFERÊNCIA = '" & Me.ComboBox_mes & "';"

    Else

    MsgBox "PARA ATUALIZAR, CLICK NO CAMPO PESQUISAR MÊS E DIGITE UMA REFERÊNCIA VÁLIDA", vbInformation
    Exit Sub
    End If


    If Me.Text_consumoagua <> "" Then
    Sql = "insert into [AGUA$] (VALOR, CONSUMO, STATUS, PAGAMENTO, MÊS_REFERÊNCIA, VENCIMENTO, NÚMERO_CONTA) VALUES ('" & Me.ComboBox_mes & "', VENCIMENTO = '" & Me.Text_vencimentoagua & "' , VALOR = '" & Me.Text_valoragua & "' , NÚMERO_CONTA = '" & Me.Text_numerocontaagua & "', CONSUMO = '" & Me.Text_consumoagua & "', STATUS = '" & Me.ComboBoxstatus & "', PAGAMENTO = '" & Me.Text_datapagamentoagua & "' where MÊS_REFERÊNCIA = '" & Me.ComboBox_mes & "';"

    Else

    MsgBox "PARA ATUALIZAR, CLICK NO CAMPO PESQUISAR MÊS E DIGITE UMA REFERÊNCIA VÁLIDA", vbInformation
    Exit Sub
    End If


    If Me.Text_vencimentoagua <> "" Then
    Sql = "insert into [AGUA$] (VALOR, CONSUMO, STATUS, PAGAMENTO, MÊS_REFERÊNCIA, VENCIMENTO, NÚMERO_CONTA) VALUES ('" & Me.ComboBox_mes & "', VENCIMENTO = '" & Me.Text_vencimentoagua & "' , VALOR = '" & Me.Text_valoragua & "' , NÚMERO_CONTA = '" & Me.Text_numerocontaagua & "', CONSUMO = '" & Me.Text_consumoagua & "', STATUS = '" & Me.ComboBoxstatus & "', PAGAMENTO = '" & Me.Text_datapagamentoagua & "' where MÊS_REFERÊNCIA = '" & Me.ComboBox_mes & "';"

    Else

    MsgBox "PARA ATUALIZAR, CLICK NO CAMPO PESQUISAR MÊS E DIGITE UMA REFERÊNCIA VÁLIDA", vbInformation
    Exit Sub
    End If


    If Me.Text_valoragua <> "" Then
    Sql = "insert into [AGUA$] (VALOR, CONSUMO, STATUS, PAGAMENTO, MÊS_REFERÊNCIA, VENCIMENTO, NÚMERO_CONTA) VALUES ('" & Me.ComboBox_mes & "', VENCIMENTO = '" & Me.Text_vencimentoagua & "' , VALOR = '" & Me.Text_valoragua & "' , NÚMERO_CONTA = '" & Me.Text_numerocontaagua & "', CONSUMO = '" & Me.Text_consumoagua & "', STATUS = '" & Me.ComboBoxstatus & "', PAGAMENTO = '" & Me.Text_datapagamentoagua & "' where MÊS_REFERÊNCIA = '" & Me.ComboBox_mes & "';"

    Else

    MsgBox "CAMPO VALOR OBRIGATÓRIO", vbExclamation
    Exit Sub
    End If

    'CÓDIGO PARA VERIFICAR SE O VALOR DO TEXTBOX ESTÁ REGISTRADO NA TABELA, SE O N° DO TEXTBOX NÃO ESTIVER REGISTRADO
    'ENTÃO EXIBE A MSG NÃO É POSSÍVEL ALTERAR.

    col = 5
           lin = 2
           While (Plan4.Cells(lin, col) <> Me.Text_numerocontaagua)
               lin = lin + 1
               If lin > 5000 Then
                   MsgBox "IMPOSSÍVEL ALTERAR O NÚMERO DA CONTA", vbCritical
                   Exit Sub
               End If
    Wend

    'CÓDIGO PARA VERIFICAR SE O VALOR DO TEXTBOX ESTÁ REGISTRADO NA TABELA, SE O N° DO TEXTBOX NÃO ESTIVER REGISTRADO
    'ENTÃO EXIBE A MSG NÃO É POSSÍVEL ALTERAR.

    col = 8
           lin = 2
           While (Plan4.Cells(lin, col) <> Me.Text_datapagamentoagua)
               lin = lin + 1
               If lin > 5000 Then
                   MsgBox "IMPOSSÍVEL ALTERAR DATA DE PAGAMENTO", vbCritical
                   Exit Sub
               End If
    Wend

    'CÓDIGO PARA ATUALIZAR OS CAMPOS DOS TEXTBOX

    Set BANCO = OpenDatabase(ThisWorkbook.Path & "/" & ThisWorkbook.Name, False, False, "Excel 8.0")

    Sql = "UPDATE  [AGUA$] SET NÚMERO_CONTA = '" & Me.Text_numerocontaagua & "', STATUS = '" & Me.ComboBoxstatus & "', PAGAMENTO = '" & Me.Text_datapagamentoagua & "', MÊS_REFERÊNCIA = '" & Me.ComboBox_mes & "', VENCIMENTO = '" & Me.Text_vencimentoagua & "' , VALOR = '" & Me.Text_valoragua & "', CONSUMO = '" & Me.Text_consumoagua & "', ANO = '" & Me.ComboBoxano & "'where NÚMERO_CONTA = '" & Me.Text_numerocontaagua & "';"

    BANCO.Execute Sql

     
    MsgBox "DADOS ATUALIZADOS COM SUCESSO"

    'CÓDIGO LIMPAR CAMPOS
    Me.Text_consumoagua = ""
    Me.Text_datapagamentoagua = ""
    Me.ComboBox_mes = ""
    Me.Text_numerocontaagua = ""
    Me.Text_pesquisaragua = ""
    Me.ComboBoxstatus = ""
    Me.Text_valoragua = ""
    Me.Text_vencimentoagua = ""
    Me.ComboBoxano = ""
    Me.ComboBoxstatus = ""

    End Sub

    Private Sub Command_cadastraragua_Click()

    'CÓDIGO PARA EVITAR DUPLICAÇÃO DE CADASTRO NA PLANILHA

    Set TABELA = BANCO.OpenRecordset("SELECT * FROM [AGUA$] WHERE Número_Conta = '" & Me.Text_numerocontaagua & "';")
    If TABELA.EOF And TABELA.BOF Then

    Else
    MsgBox "DADOS JÁ CADASTRADOS", vbCritical
    Exit Sub

    End If

    'CÓDIGO PARA INSERIR DADOS NAS TABELAS
    If Me.Text_numerocontaagua <> "" Then 'ESSE PARAMETRO IF EVITA QUE TODA VEZ AO CLICAR NO BOTÃO INSERIR ELE INSIRA LINHAS VAZIAS TIPO CADASTRA CAMPO VAZIO COMO SE TIVESSE SIDO PREENCHIDO.
    BANCO.Execute "INSERT INTO [AGUA$] (Código, Mês_Referência, Vencimento, Valor, Número_Conta, Consumo, Status, Pagamento, Ano) VALUES ('" & Me.TextBox_codigo & "', '" & Me.ComboBox_mes & "','" & Me.Text_vencimentoagua & "','" & Me.Text_valoragua & "','" & Me.Text_numerocontaagua & "','" & Me.Text_consumoagua & "','" & Me.ComboBoxstatus & "', '" & Me.Text_datapagamentoagua & "', '" & Me.ComboBoxano & "')"
    End If

    'CÓDIGO DEIXAR LETRAS EM MAIUSCULO
    Me.ComboBox_mes = UCase(Me.ComboBox_mes.Text)
    Me.ComboBoxstatus = UCase(Me.ComboBoxstatus.Text)


    'PARA APARECER O CÓDIGO PRECISA COLOCAR CLICAR NO FORMULÁRIO E MUDAR O EVENTO PARA INICIALIZE E COLAR O CÓDIGO ABAIXO
    'NA SEQUÊNCIA PARA ELE APARECER NO ATUALIZANDO O VALOR DE +1 TEM QUE COLAR ELE AQUI NO BOTÃO INSERIR, AI ELE ATUALIZA TUDO CERTINHO

    Set TABELA = BANCO.OpenRecordset("SELECT COUNT (VALOR)+1 AS CONTAR FROM [AGUA$];")
    Me.TextBox_codigo = TABELA("CONTAR")


    'CÓDIGO PARA TORNAR OBRIGATÓRIO PREENCHIMENTO DE CAMPOS EM BRANCO

    Set BANCO = OpenDatabase(ThisWorkbook.Path & "/" & ThisWorkbook.Name, False, False, "Excel 8.0")

    If Me.Text_numerocontaagua <> "" Then
    Sql = "insert into [AGUA$] (VALOR, CONSUMO, STATUS, PAGAMENTO, MÊS_REFERÊNCIA, VENCIMENTO, NÚMERO_CONTA) VALUES ('" & Me.ComboBox_mes & "', VENCIMENTO = '" & Me.Text_vencimentoagua & "' , VALOR = '" & Me.Text_valoragua & "' , NÚMERO_CONTA = '" & Me.Text_numerocontaagua & "', CONSUMO = '" & Me.Text_consumoagua & "', STATUS = '" & Me.ComboBoxstatus & "', PAGAMENTO = '" & Me.Text_datapagamentoagua & "' where MÊS_REFERÊNCIA = '" & Me.ComboBox_mes & "';"

    Else

    MsgBox "CAMPO NÚMERO DA CONTA OBRIGATÓRIO", vbInformation
    Exit Sub
    End If

    If Me.ComboBoxano <> "" Then
    Sql = "insert into [AGUA$] (VALOR, CONSUMO, STATUS, PAGAMENTO, MÊS_REFERÊNCIA, VENCIMENTO, NÚMERO_CONTA) VALUES ('" & Me.ComboBox_mes & "', VENCIMENTO = '" & Me.Text_vencimentoagua & "' , VALOR = '" & Me.Text_valoragua & "' , NÚMERO_CONTA = '" & Me.Text_numerocontaagua & "', CONSUMO = '" & Me.Text_consumoagua & "', STATUS = '" & Me.ComboBoxstatus & "', PAGAMENTO = '" & Me.Text_datapagamentoagua & "' where MÊS_REFERÊNCIA = '" & Me.ComboBox_mes & "';"

    Else

    MsgBox "CAMPO ANO OBRIGATÓRIO", vbInformation
    Exit Sub
    End If

    If Me.ComboBoxstatus <> "" Then
    Sql = "insert into [AGUA$] (VALOR, CONSUMO, STATUS, PAGAMENTO, MÊS_REFERÊNCIA, VENCIMENTO, NÚMERO_CONTA) VALUES ('" & Me.ComboBox_mes & "', VENCIMENTO = '" & Me.Text_vencimentoagua & "' , VALOR = '" & Me.Text_valoragua & "' , NÚMERO_CONTA = '" & Me.Text_numerocontaagua & "', CONSUMO = '" & Me.Text_consumoagua & "', STATUS = '" & Me.ComboBoxstatus & "', PAGAMENTO = '" & Me.Text_datapagamentoagua & "' where MÊS_REFERÊNCIA = '" & Me.ComboBox_mes & "';"

    Else

    MsgBox "CAMPO STATUS OBRIGATÓRIO", vbInformation
    Exit Sub
    End If

    If Me.ComboBox_mes <> "" Then
    Sql = "insert into [AGUA$] (VALOR, CONSUMO, STATUS, PAGAMENTO, MÊS_REFERÊNCIA, VENCIMENTO, NÚMERO_CONTA) VALUES ('" & Me.ComboBox_mes & "', VENCIMENTO = '" & Me.Text_vencimentoagua & "' , VALOR = '" & Me.Text_valoragua & "' , NÚMERO_CONTA = '" & Me.Text_numerocontaagua & "', CONSUMO = '" & Me.Text_consumoagua & "', STATUS = '" & Me.ComboBoxstatus & "', PAGAMENTO = '" & Me.Text_datapagamentoagua & "' where MÊS_REFERÊNCIA = '" & Me.ComboBox_mes & "';"

    Else

    MsgBox "CAMPO MÊS DE REFERÊNCIA OBRIGATÓRIO", vbInformation
    Exit Sub
    End If

    If Me.Text_consumoagua <> "" Then
    Sql = "insert into [AGUA$] (VALOR, CONSUMO, STATUS, PAGAMENTO, MÊS_REFERÊNCIA, VENCIMENTO, NÚMERO_CONTA) VALUES ('" & Me.ComboBox_mes & "', VENCIMENTO = '" & Me.Text_vencimentoagua & "' , VALOR = '" & Me.Text_valoragua & "' , NÚMERO_CONTA = '" & Me.Text_numerocontaagua & "', CONSUMO = '" & Me.Text_consumoagua & "', STATUS = '" & Me.ComboBoxstatus & "', PAGAMENTO = '" & Me.Text_datapagamentoagua & "' where MÊS_REFERÊNCIA = '" & Me.ComboBox_mes & "';"

    Else

    MsgBox "CAMPO CONSUMO M3 OBRIGATÓRIO", vbInformation
    Exit Sub
    End If


    If Me.Text_vencimentoagua <> "" Then
    Sql = "insert into [AGUA$] (VALOR, CONSUMO, STATUS, PAGAMENTO, MÊS_REFERÊNCIA, VENCIMENTO, NÚMERO_CONTA) VALUES ('" & Me.ComboBox_mes & "', VENCIMENTO = '" & Me.Text_vencimentoagua & "' , VALOR = '" & Me.Text_valoragua & "' , NÚMERO_CONTA = '" & Me.Text_numerocontaagua & "', CONSUMO = '" & Me.Text_consumoagua & "', STATUS = '" & Me.ComboBoxstatus & "', PAGAMENTO = '" & Me.Text_datapagamentoagua & "' where MÊS_REFERÊNCIA = '" & Me.ComboBox_mes & "';"

    Else

    MsgBox "CAMPO DATA DE VENCIMENTO OBRIGATÓRIO", vbInformation
    Exit Sub
    End If


    If Me.Text_valoragua <> "" Then
    Sql = "insert into [AGUA$] (VALOR, CONSUMO, STATUS, PAGAMENTO, MÊS_REFERÊNCIA, VENCIMENTO, NÚMERO_CONTA) VALUES ('" & Me.ComboBox_mes & "', VENCIMENTO = '" & Me.Text_vencimentoagua & "' , VALOR = '" & Me.Text_valoragua & "' , NÚMERO_CONTA = '" & Me.Text_numerocontaagua & "', CONSUMO = '" & Me.Text_consumoagua & "', STATUS = '" & Me.ComboBoxstatus & "', PAGAMENTO = '" & Me.Text_datapagamentoagua & "' where MÊS_REFERÊNCIA = '" & Me.ComboBox_mes & "';"

    Else

    MsgBox "CAMPO VALOR OBRIGATÓRIO", vbInformation
    Exit Sub
    End If


    If Me.Text_datapagamentoagua <> "" Then
    Sql = "insert into [AGUA$] (VALOR, CONSUMO, STATUS, PAGAMENTO, MÊS_REFERÊNCIA, VENCIMENTO, NÚMERO_CONTA) VALUES ('" & Me.ComboBox_mes & "', VENCIMENTO = '" & Me.Text_vencimentoagua & "' , VALOR = '" & Me.Text_valoragua & "' , NÚMERO_CONTA = '" & Me.Text_numerocontaagua & "', CONSUMO = '" & Me.Text_consumoagua & "', STATUS = '" & Me.ComboBoxstatus & "', PAGAMENTO = '" & Me.Text_datapagamentoagua & "' where MÊS_REFERÊNCIA = '" & Me.ComboBox_mes & "';"
    MsgBox "PAGAMENTO REALIZADO COM SUCESSO"

    'CÓDIGO PARA LIMPAR CÉLULAS
    Me.Text_consumoagua = ""
    Me.Text_datapagamentoagua = ""
    Me.ComboBox_mes = ""
    Me.Text_numerocontaagua = ""
    Me.Text_pesquisaragua = ""
    Me.ComboBoxstatus = ""
    Me.Text_valoragua = ""
    Me.Text_vencimentoagua = ""
    Me.ComboBoxano = ""


    ElseIf Me.Text_datapagamentoagua = "" Then
    MsgBox "CADASTRO REALIZADO COM SUCESSO"


    'CÓDIGO PARA LIMPAR CÉLULAS
    Me.Text_consumoagua = ""
    Me.Text_datapagamentoagua = ""
    Me.ComboBox_mes = ""
    Me.Text_numerocontaagua = ""
    Me.Text_pesquisaragua = ""
    Me.ComboBoxstatus = ""
    Me.Text_valoragua = ""
    Me.Text_vencimentoagua = ""
    Me.ComboBoxano = ""

    Exit Sub
    End If

    'Mostrar a quantidade de registros que há em todo banco de dados:

    Set TABELA = BANCO.OpenRecordset("SELECT COUNT (VALOR) AS CONTAR FROM [AGUA$];")
    Me.TextBoxregistros = TABELA("CONTAR")

    End Sub


    Private Sub Command_editaragua_Click()

    If Me.Text_pesquisaragua = "" Then

    MsgBox "INSIRA UMA REFERÊNCIA VÁLIDA NO CAMPO PESQUISAR MÊS ", vbInformation
    Exit Sub
    End If


    'CÓDIGO PARA PESQUISAR CAMPOS NO TEXTBOX

    Set TABELA = BANCO.OpenRecordset("SELECT VALOR, CONSUMO, STATUS, PAGAMENTO, MÊS_REFERÊNCIA, VENCIMENTO, NÚMERO_CONTA, ANO FROM [AGUA$] WHERE MÊS_REFERÊNCIA = '" & Me.Text_pesquisaragua & "';")
    If TABELA.EOF And TABELA.BOF Then

    Else

    If TABELA("VALOR") <> "" Then
    Me.Text_valoragua = TABELA("VALOR")
    End If

    If TABELA("MÊS_REFERÊNCIA") <> "" Then
    Me.ComboBox_mes = TABELA("MÊS_REFERÊNCIA")
    End If


    If TABELA("NÚMERO_CONTA") <> "" Then
    Me.Text_numerocontaagua = TABELA("NÚMERO_CONTA")
    End If

    If TABELA("CONSUMO") <> "" Then
    Me.Text_consumoagua = TABELA("CONSUMO")
    End If

    If TABELA("STATUS") <> "" Then
    Me.ComboBoxstatus = TABELA("STATUS")
    End If

    If TABELA("PAGAMENTO") <> "" Then
    Me.Text_datapagamentoagua = TABELA("PAGAMENTO")
    End If

    If TABELA("VENCIMENTO") <> "" Then
    Me.Text_vencimentoagua = TABELA("VENCIMENTO")
    End If

    If TABELA("ANO") <> "" Then
    Me.ComboBoxano = TABELA("ANO")
    End If

    End If

    Me.Text_pesquisaragua = UCase(Me.Text_pesquisaragua.Text)


    End Sub

    Private Sub Command_sairagua_Click()
    Unload Me
    End Sub



    Private Sub CommandButton2_Click()
    Form_Consulta_Geral.Show

    End Sub

    Private Sub Frame5_Click()

    End Sub

    Private Sub Text_consumoagua_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    'CÓDIGO DE MÁSCARAS PARA NÚMEROS (DATA, CPF, MOEDA ETC...)
    Text_consumoagua.MaxLength = 2 '12
    Select Case KeyAscii
         Case 8       'Aceita o BACK SPACE
         Case 13: SendKeys "{TAB}"    'Emula o TAB
         Case 48 To 57
           
         Case Else: KeyAscii = 0     'Ignora os outros caracteres
      End Select

    End Sub

    Private Sub Text_datapagamentoagua_Exit(ByVal Cancel As MSForms.ReturnBoolean)
       'CÓDIGO PARA TORNAR OBRIGATÓRIO PREENCHER UM DETERMINADO NÚMERO
       'DE CARACTERES NO TEXTBOX, TEM QUE SER NO EVENTO EXIT
       If Len(Me.Text_datapagamentoagua.Text) < 6 Then
           MsgBox "DIGITE UMA DATA VÁLIDA EX: DD/MM/AA", vbCritical, "ERRO"
           Me.Text_datapagamentoagua.Text = ""
           Cancel = False
       End If
    End Sub


    Private Sub Text_datapagamentoagua_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    'CÓDIGO DE MÁSCARAS PARA NÚMEROS (DATA, CPF, MOEDA ETC...)

    Text_datapagamentoagua.MaxLength = 8 '10/10/14
    Select Case KeyAscii
         Case 8       'Aceita o BACK SPACE
         Case 13: SendKeys "{TAB}"    'Emula o TAB
         Case 48 To 57
            If Text_datapagamentoagua.SelStart = 2 Then Text_datapagamentoagua.SelText = "/"
            If Text_datapagamentoagua.SelStart = 5 Then Text_datapagamentoagua.SelText = "/"
         Case Else: KeyAscii = 0     'Ignora os outros caracteres
      End Select
    End Sub


    Private Sub Text_numerocontaagua_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    'CÓDIGO DE MÁSCARAS PARA NÚMEROS (DATA, CPF, MOEDA ETC...)
    Text_numerocontaagua.MaxLength = 13 '1412041714461
    Select Case KeyAscii
         Case 8       'Aceita o BACK SPACE
         Case 13: SendKeys "{TAB}"    'Emula o TAB
         Case 48 To 57
            If Text_numerocontaagua.SelStart = 0 Then Text_numerocontaagua.SelText = ""
           
         Case Else: KeyAscii = 0     'Ignora os outros caracteres
      End Select
    End Sub




    Private Sub Text_pesquisaragua_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    'CÓDIGO PARA DETERMINAR QUAIS CARACTERES ESPECIAIS À SER DIGITADO EM UMA TEXTBOX, FAZER NO EVENTO KEYPRESS
    Dim strValid As String
    strValid = "Á É Í Ó Ú À Â Ê Ô Ã Õ Ç á é í ó ú à â ê ô ã õ ç"
    If InStr(strValid, Chr(KeyAscii)) = 0 Then

    '65 a 90 corresponde as letras Minúsculas do alfabeto
    If (KeyAscii < 65 Or KeyAscii > 90) Then

    '65 a 90 corresponde as letras Maiúsculas do alfabeto
    If (KeyAscii < 97 Or KeyAscii > 122) Then

    'código para inserir Backspace (Cool
    If (KeyAscii <> Cool Then

    'código para inserir Enter (13)
    If (KeyAscii <> 13) Then

    'código para inserir Espaço (13)
    If (KeyAscii <> 32) Then

    KeyAscii = 0

    End If
    End If
    End If
    End If
    End If
    End If
    End Sub

    Private Sub Text_valoragua_afterupdate()
    Text_valoragua.Text = Format(Text_valoragua.Text, "Currency")
    End Sub

    Private Sub Text_valoragua_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    ' CÓDIGO PARA DIGITAR SOMENTE NÚMEROS NO TEXTBOX DETERMINAR VÍRGULA, PONTO ETC...
    Dim strValid As String
    strValid = "0123456789,."
    If InStr(strValid, Chr(KeyAscii)) = 0 Then
    KeyAscii = 0
    End If
    End Sub

    Private Sub Text_vencimentoagua_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    'CÓDIGO PARA TORNAR OBRIGATÓRIO PREENCHER UM DETERMINADO NÚMERO
       'DE CARACTERES NO TEXTBOX, TEM QUE SER NO EVENTO EXIT
    If Len(Me.Text_vencimentoagua) < 6 Then
           MsgBox "DIGITE UMA DATA VÁLIDA EX: DD/MM/AA", vbCritical, "ERRO"
           Me.Text_vencimentoagua.Text = ""
           Cancel = False
           'NOTA ESSE CANCEL SE DEIXAR TRUE, ELE NÃO DEIXA SAIR DO TEXTBOX ATÉ QUE VC PREENCHA O VALOR CORRETO
           'SE DEIXAR FALSE ELE EXIBE A MSG ACIMA É DEIXA IR PARA O PRÓXIMO
       End If
    End Sub

    Private Sub Text_vencimentoagua_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    'CÓDIGO DE MÁSCARAS PARA NÚMEROS (DATA, CPF, MOEDA ETC...)
    Text_vencimentoagua.MaxLength = 8 '10/10/2014
    Select Case KeyAscii
         Case 8       'Aceita o BACK SPACE
         Case 13: SendKeys "{TAB}"    'Emula o TAB
         Case 48 To 57
            If Text_vencimentoagua.SelStart = 2 Then Text_vencimentoagua.SelText = "/"
            If Text_vencimentoagua.SelStart = 5 Then Text_vencimentoagua.SelText = "/"
         Case Else: KeyAscii = 0     'Ignora os outros caracteres
      End Select

    End Sub


    Private Sub TextBox2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

    'KeyAscii é o Alfabeto do teclado do computador
    'De 48 a 57 corresponde dos números de 1 a 9


    '65 a 90 corresponde as letras Minúsculas do alfabeto
    If (KeyAscii < 65 Or KeyAscii > 90) Then

    '65 a 90 corresponde as letras Maiúsculas do alfabeto
    If (KeyAscii < 97 Or KeyAscii > 122) Then

    'código para inserir Backspace (Cool
    If (KeyAscii <> Cool Then

    'código para inserir Enter (13)
    If (KeyAscii <> 13) Then

    'código para inserir Espaço (13)
    If (KeyAscii <> 32) Then

    KeyAscii = 0

    End If
    End If
    End If
    End If
    End If

    End Sub

    Private Sub TextBox_codigo_Change()

    End Sub

    Private Sub TextBoxregistros_Change()

    End Sub

    Private Sub UserForm_Activate()


    'OBS IMPORTANTE COLOCAR ESSE CÓDIGO PARA MOSTRAR O REGISTRO NO ACTIVATE E TEM QUE CLICAR DENTRO DO USEFORM
    'Mostrar a quantidade de registros que há em todo banco de dados:

    Set TABELA = BANCO.OpenRecordset("SELECT COUNT (VALOR) AS CONTAR FROM [AGUA$];")
    Me.TextBoxregistros = TABELA("CONTAR")

    Set TABELA = BANCO.OpenRecordset("SELECT COUNT (VALOR)+1 AS CONTAR FROM [AGUA$];")
    Me.TextBox_codigo = TABELA("CONTAR")


    End Sub


    Private Sub UserForm_Initialize()


    'CÓDIGO PARA CARREGAR LISTBOX PODE SER ANO, ESTADO ETC...

    Set BANCO = OpenDatabase(ThisWorkbook.Path & "/" & ThisWorkbook.Name, False, False, "Excel 8.0")
    Set TABELA = BANCO.OpenRecordset("SELECT ANO FROM [ANO$]")
    Do Until TABELA.EOF
    Me.ComboBoxano.AddItem TABELA("ANO")
    TABELA.MoveNext
    Loop

    'CÓDIGO PARA CARREGAR LISTBOX PODE SER ANO, ESTADO ETC...

    Set BANCO = OpenDatabase(ThisWorkbook.Path & "/" & ThisWorkbook.Name, False, False, "Excel 8.0")
    Set TABELA = BANCO.OpenRecordset("SELECT STATUS FROM [STATUS$]")
    Do Until TABELA.EOF
    Me.ComboBoxstatus.AddItem TABELA("STATUS")
    TABELA.MoveNext
    Loop
    'CÓDIGO PARA CARREGAR LISTBOX PODE SER ANO, ESTADO ETC...
    Set BANCO = OpenDatabase(ThisWorkbook.Path & "/" & ThisWorkbook.Name, False, False, "Excel 8.0")
    Set TABELA = BANCO.OpenRecordset("SELECT MONTH FROM [MES$]")
    Do Until TABELA.EOF
    Me.ComboBox_mes.AddItem TABELA("MONTH")
    TABELA.MoveNext
    Loop


    End Sub


    Última edição por Eduardopaulomartins em Qua 18 Jun 2014, 04:20, editado 1 vez(es)

    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 5889
    Registrado : 05/11/2009

    Re: MÓDULO VBA URGENTE AJUDEM

    Mensagem  Alexandre Neves em Ter 17 Jun 2014, 19:34

    boa tarde, e bem-vindo ao fórum
    Leia as regras e respeite-as
    Não deve utilizar Urgente, etc. O fórum e de participação livre
    Escrever em maiúsculas significa gritar. Edite o título e adeqúe-o às regras

    Sobre a sua dúvida, e porque o código é extenso e não tenho tenho tempo para lhe dedicar:
    - Cole o código num módulo
    - Depure o código e será acusado as partes que ele não reconhece separado do formulário. Utilize argumentos para passar os valores
    - Execute o código e ele vai-lhe pedir para inserir o valor de parâmetros que desconhece. Faça como na situação anterior
    . No final, o código deverá ficar do género:
    Sub MostraCampos(strTabela As String) --> o procedimento chama-se MostraCampos, é passado o argumento strTabela que passa o nome da tabela (tipo de dados string)


    .................................................................................
    Access 2010. Mande bd que dê para testar (indique a versão). Não peça para fazer o que já tem feito. Dê todos os detalhes.
    Não coloquem entraves como senhas, esconder controlos, etc. Disponibilizem o mais limpo possível
    Só respondo a mensagens privadas, se forem de assunto privado; às outras não respondo.
    Quem trabalha e mata a fome não come o pão de ninguém; mas quem não trabalha e come, come sempre o pão de alguém. António Aleixo

    Silvio
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3235
    Registrado : 20/04/2011

    Re: MÓDULO VBA URGENTE AJUDEM

    Mensagem  Silvio em Ter 17 Jun 2014, 22:07

    Sugiro buscar um fórum próprio para o Excel.


    .................................................................................
    Caso tenha resolvido a tua duvida, coloque o tópico como resolvido.
    [Você precisa estar registrado e conectado para ver este link.]

      Data/hora atual: Ter 06 Dez 2016, 05:42