MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

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)
    avatar
    Alexandre Neves
    Moderador Global
    Moderador Global

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Portugal
    Mensagens : 6445
    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
    avatar
    Silvio
    Developer
    Developer

    Respeito às Regras 100%

    Sexo : Masculino
    Localização : Brasil
    Mensagens : 3648
    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: Seg 23 Out 2017, 16:06