Ir para conteúdo
Fórum Script Brasil
  • 0

Erro 91

bira2004

Perguntado por bira2004,

 Share

Pergunta

bira2004

bira2004

Postado
Postado (editado)

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

Editado por kuroi
Adicionar tag CODE
Link para o comentário
Compartilhar em outros sites

1 resposta a esta questão

Posts Recomendados

Participe da discussão

Você pode postar agora e se registrar depois. Se você já tem uma conta, acesse agora para postar com sua conta.

Visitante
Responder esta pergunta...

×   Você colou conteúdo com formatação.   Remover formatação

  Apenas 75 emoticons são permitidos.

×   Seu link foi incorporado automaticamente.   Exibir como um link em vez disso

×   Seu conteúdo anterior foi restaurado.   Limpar Editor

×   Você não pode colar imagens diretamente. Carregar ou inserir imagens do URL.

×
 Share
Ir para lista de Perguntas


  • Estatísticas dos Fóruns

    • Tópicos
      152,5k
    • Posts
      652,4k
×
×
  • Criar Novo...