bira2004

O meu " programa" funciona perfeitamente quando dou play no VB6. Quando eu monto o .exe... ele da erro nos botoes cmdprimeiro,anterior,proximo,ultimo, no botao excluir e quando eu fecho o FOrmulario ( mdi ). Os outros botoes funcionam perfeitamente... Segue o codigo.. Dim TBCLIENTES As Recordset Dim Salvar As Boolean '*****************HABILITAR*******DESABILITAR************** Private Sub Habilitar() 'HABILITA OS CAMPOS CmdPrimeiro.Enabled = True CmdProximo.Enabled = True CmdAnterior.Enabled = True CmdUltimo.Enabled = True CmdNovo.Enabled = True CmdExcluir.Enabled = True CmdAlterar.Enabled = True End Sub Private Sub Desabilitar() 'DESABILITA OS CAMPOS CmdPrimeiro.Enabled = False CmdProximo.Enabled = False CmdAnterior.Enabled = False CmdUltimo.Enabled = False CmdNovo.Enabled = False CmdExcluir.Enabled = False CmdAlterar.Enabled = False End Sub '************MOSTRAR**COMPLETAR*******LIMPAR*********** Private Sub MOSTRAR() 'CANCELA ERROS NA FUNÇÃO On Error Resume Next 'CARREGA CAMPOS TxtCodigo.Text = TBCLIENTES!Codigo txtnome.Text = TBCLIENTES!NOME Txtidade.Text = TBCLIENTES!idade TxtEndereco.Text = TBCLIENTES!Endereco MskCEP.Text = TBCLIENTES!Cep TxtCidade.Text = TBCLIENTES!CIDADE txtddd.Text = TBCLIENTES!DDD TxtContato.Text = TBCLIENTES!Contato txtemail.Text = TBCLIENTES!email txtsite.Text = TBCLIENTES!OBS End Sub Private Sub COMPLETAR() 'CARREGA VARIAVEIS PARA GRAVAR TBCLIENTES!idade = Txtidade.Text TBCLIENTES!Codigo = TxtCodigo.Text TBCLIENTES!NOME = txtnome.Text TBCLIENTES!Endereco = TxtEndereco.Text TBCLIENTES!Cep = MskCEP.Text TBCLIENTES!Bairro = txtbairro.Text TBCLIENTES!CIDADE = TxtCidade.Text TBCLIENTES!DDD = txtddd.Text TBCLIENTES!Contato = TxtContato.Text TBCLIENTES!email = txtemail.Text TBCLIENTES!OBS = txtsite.Text End Sub Private Sub Limpar() 'LIMPA CAMPOS TxtCodigo.Text = "" txtnome.Text = "" TxtEndereco.Text = "" MskCEP.Text = "" Txtidade.Text = "" txtbairro.Text = "" TxtCidade.Text = "" txtddd.Text = "" TxtContato.Text = "" txtemail.Text = "" txtsite.Text = "" End Sub '*****************FORM*********************** Private Sub Form_KeyPress(KeyAscii As Integer) If KeyAscii = 27 Then End End If KeyAscii = Asc((UCase$(Chr(KeyAscii)))) End Sub Private Sub Form_Load() On Error Resume Next 'CHAMA A FUNÇÃO CONEXAO Call CONEXAO Dim strCaractere As String strCaractere = Chr(KeyAscii) KeyAscii = Asc(UCase(strCaractere)) 'CARREGA O REGISTRO NA VARIAVEL RECODSET Set TBCLIENTES = BD.OpenRecordset("TbClientes", dbOpenDynaset) 'CHAMA A FUNÇÃO QUE DESABILITAR OS BOTÃO Call Desabilitar 'VERIFICA SE TEM REGISTRO OU NÃO If TBCLIENTES.RecordCount > 0 Then Salvar = False 'CHAMA A FUNÇÃO QUE HABILITAR OS BOTÃO Call Habilitar 'MOVE REGISTRO PARA O PRIMEIRO TBCLIENTES.MoveFirst 'CARREGA OS CAMPOS PARA MOSTAR NA TELA Call MOSTRAR Frame1.Enabled = False Else 'CARREGA A VARIAVEL COM TRUE Salvar = True 'CHAMA A FUNÇÃO QUE DESABILITAR OS BOTÃO Call Desabilitar CmdSalvar.Enabled = True 'CHAMA A FUNÇÃO LIMPAR Frame1.Enabled = True End If End Sub '*****************************BOTÕES******************************* Private Sub CmdSalvar_Click() On Error Resume Next 'VERIFICA SE O CAMPO TA VAZIO If TxtCodigo.Text = "" Then MsgBox "Campo Ficha Incompleto", vbInformation, "Salvar" TxtCodigo.SetFocus 'CAMCELA O FUNÇÃO Exit Sub End If 'VERIFICA SE É TRUE OU NÃO If Salvar = True Then 'PREPARA A VARIAVEL PARA RECEBER OS DADOS NOVOS TBCLIENTES.AddNew 'CARREGA OS CAMPOS Call COMPLETAR 'GRAVA OS REGISTRO NA TABELA TBCLIENTES.Update 'VERIFICA O ERRO DE DUPLICIDADE DE (CHAVE PRIMARIA) If Err = "3022" Then 'CAIXA DE MESSAGEM MsgBox "ESTE CÓDIGO JÁ FOI CADASTRADO", vbInformation, "Salvar" TxtCodigo.Text = "" TxtCodigo.SetFocus Exit Sub End If 'MOVE PARA O ULTIMO REGISTRO TBCLIENTES.MoveLast Salvar = False 'CHAMA A FUNÇÃO QUE HABILITAR OS BOTÃO Call Habilitar Else 'PREPARA A VARIAVEL PARA RECEBER OS DADOS PARA EDITAR O REGISTRO ATUAL TBCLIENTES.Edit 'CARREGA OS CAMPOS Call COMPLETAR 'GRAVA OS REGISTRO NA TABELA TBCLIENTES.Update End If CmdCancelar.Enabled = False CmdSalvar.Enabled = False 'CHAMA A FUNÇÃO QUE HABILITAR OS BOTÃO Call Habilitar Frame1.Enabled = False Call CmdNovo.SetFocus End Sub Private Sub CmdNovo_Click() On Error Resume Next Dim NUMERO As Double 'ATUALIZA A VARIAVEL COM OS DADOS DA BASE DE DADOS Set TBCLIENTES = BD.OpenRecordset("select * from TbClientes ORDER BY codigo") 'CHAMA A FUNÇÃO LIMPAR Call Limpar 'VERIFICA SE TEM REGISTRO If TBCLIENTES.RecordCount > 0 Then 'MOVE PARA O ULTIMO TBCLIENTES.MoveLast 'CARREGA A VARIAVEL NUMERO = TBCLIENTES!Codigo 'CONTA A VARIAVEL + 1 NUMERO = NUMERO + 1 'PASSA O RESULTADO PARA O CAMPO TxtCodigo.Text = NUMERO Else 'SE NÃO TIVER REGITRO ELA RECEBE 1 TxtCodigo.Text = "1" End If Frame1.Enabled = True 'CHAMA A FUNÇÃO QUE DESABILITAR OS BOTÃO Call Desabilitar CmdCancelar.Enabled = True CmdSalvar.Enabled = True Salvar = True TxtCodigo.SetFocus End Sub Private Sub CMDExcluir_Click() Dim resp As Integer If TBCLIENTES.RecordCount > 0 Then resp = MsgBox("Tem certeza que deseja Excluir este Registro", 36, "Excluir") 'VERIFICA A RESPOSTA DA MSG If resp = 6 Then 'DELETA O REGISTRO ATUAL TBCLIENTES.Delete TBCLIENTES.MoveFirst If TBCLIENTES.RecordCount > 0 Then TBCLIENTES.MoveFirst 'CARREGA OS CAMPOS PARA MOSTAR NA TELA Call MOSTRAR 'CHAMA A FUNÇÃO QUE HABILITAR OS BOTÃO Call Habilitar Salvar = False Frame1.Enabled = False Else 'CHAMA A FUNÇÃO LIMPAR Call Limpar CmdCancelar.Enabled = False CmdSalvar.Enabled = True Salvar = True 'CHAMA A FUNÇÃO QUE DESABILITAR OS BOTÃO Call Desabilitar Frame1.Enabled = True TxtCodigo.SetFocus End If End If End If End Sub Private Sub CmdFiltro_Click() On Error Resume Next IDBusca = "" 'CHAMA OUTRO FORMULARIO (JANELA) FrmClientesBusca.Show 1 'VERIFICA SE A VARIAVEL ESTA VAZIA OU CHEIA If IDBusca <> "" Then 'MANDA A INSTRUÇÃO SQL PARA A BASE DE DADOS Criterio = "CODIGO ='" & IDBusca & "'" TBCLIENTES.FindFirst Criterio 'VERIFICA SE EXISTE OU NÃO O REGISTRO If TBCLIENTES.NoMatch Then MsgBox "REGISTRO NÃO LOCALIZADO" 'CHAMA A FUNÇÃO LIMPAR Call Limpar 'CARREGA OS CAMPOS PARA MOSTAR NA TELA Call MOSTRAR 'CHAMA A FUNÇÃO QUE HABILITAR OS BOTÃO Call Habilitar Salvar = False Else 'CHAMA A FUNÇÃO LIMPAR Call Limpar 'CARREGA OS CAMPOS PARA MOSTAR NA TELA Call MOSTRAR 'CHAMA A FUNÇÃO QUE HABILITAR OS BOTÃO Call Habilitar Salvar = False End If End If End Sub Private Sub CmdAlterar_Click() Frame1.Enabled = True Salvar = False CmdCancelar.Enabled = True CmdSalvar.Enabled = True 'CHAMA A FUNÇÃO QUE DESABILITA OS BOTÃO Call Desabilitar 'DA O FOCO PARA O CAMPO txtnome.SetFocus End Sub Private Sub CmdCancelar_Click() If TBCLIENTES.RecordCount > 0 Then Call Limpar 'CARREGA OS CAMPOS PARA MOSTAR NA TELA Call MOSTRAR End If CmdCancelar.Enabled = False CmdSalvar.Enabled = False 'CHAMA A FUNÇÃO QUE HABILITAR OS BOTÃO Call Habilitar Salvar = False Frame1.Enabled = False End Sub Private Sub CMDFECHAR_Click() 'FECHA A JANELA ATIVA Hide End Sub Private Sub CmdPrimeiro_Click() 'MOVER PARA O 1º REGISTRO If TBCLIENTES.RecordCount > 0 Then 'MOVE O REGISTRO TBCLIENTES.MoveFirst 'CHAMA A FUNÇÃO LIMPAR Call Limpar 'CARREGA OS CAMPOS PARA MOSTAR NA TELA Call MOSTRAR End If End Sub Private Sub CmdAnterior_Click() 'MOVER 1 REGISTRO PARA TRAZ If TBCLIENTES.RecordCount > 0 Then 'MOVE O REGISTRO TBCLIENTES.MovePrevious 'VERIFICA SE O REGISTRO ESTA NO COMEÇO If TBCLIENTES.BOF = True Then TBCLIENTES.MoveNext End If 'CHAMA A FUNÇÃO LIMPAR Call Limpar 'CARREGA OS CAMPOS PARA MOSTAR NA TELA Call MOSTRAR End If End Sub Private Sub CmdProximo_Click() 'MOVER 1 REGISTRO PARA FENTE If TBCLIENTES.RecordCount > 0 Then 'MOVE O REGISTRO TBCLIENTES.MoveNext 'VERIFICA SE O REGISTRO ESTA NO FIM If TBCLIENTES.EOF = True Then TBCLIENTES.MovePrevious End If 'CHAMA A FUNÇÃO LIMPAR Call Limpar 'CARREGA OS CAMPOS PARA MOSTAR NA TELA Call MOSTRAR End If End Sub Private Sub CmdUltimo_Click() 'MOVER PARA O ULTIMO REGISTRO If TBCLIENTES.RecordCount > 0 Then 'MOVE O REGISTRO TBCLIENTES.MoveLast End If 'CHAMA A FUNÇÃO LIMPAR Call Limpar 'CARREGA OS CAMPOS PARA MOSTAR NA TELA Call MOSTRAR End Sub '*****************************CAMPOS******************************* Private Sub Txtcodigo_KeyPress(KeyAscii As Integer) 'PULA PARA O PROXIMO CAMPO Enter (KeyAscii) 'VERIFICA SE O VALOR DIGITADO É NUMERICO If Chr$(KeyAscii) > "0" And Chr$(KeyAscii) > "9" Then 'SE NÃO FOR NUMERICO CANCELA O QUE DIGITOU KeyAscii = 0 End If End Sub Private Sub TxtCodigo_LostFocus() 'FORMATA O CAMPO COM 6 (0 A FRENTE) If TxtCodigo.Text <> "" Then TxtCodigo = LTrim(RTrim((TxtCodigo))) While Len(TxtCodigo) < 6 TxtCodigo = "0" + TxtCodigo Wend End If End Sub Private Sub Mskdtcadastro_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) Enter (KeyAscii) If Chr$(KeyAscii) > "0" And Chr$(KeyAscii) > "9" Then End If End Sub Private Sub TXTNOME_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) Enter (KeyAscii) End Sub Private Sub TxtNFatasia_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) Enter (KeyAscii) End Sub Private Sub TXTendereco_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) Enter (KeyAscii) End Sub Private Sub TXTidade_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) Enter (KeyAscii) End Sub Private Sub TXTNUMERO_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) Enter (KeyAscii) If Chr$(KeyAscii) > "0" And Chr$(KeyAscii) > "9" Then End If End Sub Private Sub Mskcep_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) Enter (KeyAscii) If Chr$(KeyAscii) > "0" And Chr$(KeyAscii) > "9" Then End If End Sub Private Sub TXTcomplemento_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) Enter (KeyAscii) End Sub Private Sub txtbairro_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) Enter (KeyAscii) End Sub Private Sub txtddd_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) Enter (KeyAscii) If Chr$(KeyAscii) > "0" And Chr$(KeyAscii) > "9" Then End If End Sub Private Sub TxtNumFone_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) Enter (KeyAscii) If Chr$(KeyAscii) > "0" And Chr$(KeyAscii) > "9" Then End If End Sub Private Sub TxtContato_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) Enter (KeyAscii) End Sub Private Sub Txtcidade_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) Enter (KeyAscii) End Sub Private Sub TxtEmail_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) Enter (KeyAscii) End Sub Private Sub TxtSite_KeyPress(KeyAscii As Integer) KeyAscii = Asc(UCase(Chr(KeyAscii))) Enter (KeyAscii) End Sub Private Sub MSKDESCONTO_KeyPress(KeyAscii As Integer) Enter (KeyAscii) If Chr$(KeyAscii) > "0" And Chr$(KeyAscii) > "9" Then End If End Sub Private Sub form_unload(cancel As Integer) TBCLIENTES.Close End Sub