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!!!
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 (
If (KeyAscii <> 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 (
If (KeyAscii <> 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
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!!!
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 (
If (KeyAscii <> 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 (
If (KeyAscii <> 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 18/6/2014, 04:20, editado 1 vez(es)