MSFLEXGRID1

GUGU4700 23/08/2013 19:00:11
#428035
Galera, preciso de ajuda, tenho um projeto de agenda, mas estou com problema, quando digito uma letra no textbox, e o programa não encontra nada, ele dá um erro 381 e não sai da mesma tela, porem, se digitar uma letra que tem no bco de dados, ele mostra tudo, segue abaixo o código do projeto todo:
Option Explicit
Private cnn As ADODB.Connection
Private adoDataConn As ADODB.Connection
Private WithEvents rsClientes As ADODB.Recordset
Private WithEvents rsMySQL As ADODB.Recordset
Dim vCodigo As String
Dim vNome As String
Dim regContador As Integer
Public key As Integer

Private Sub TravaTela()
On Error GoTo Trata_Erro
Dim ctlControles As Control
For Each ctlControles In Controls
If TypeOf ctlControles Is TextBox And ctlControles.Tag <> 1 Then
ctlControles.Locked = True
ctlControles.ForeColor = vbBlue
End If
Next
Exit Sub
Trata_Erro: MensagensDeErro
End Sub

Private Sub Destravatela()
On Error GoTo Trata_Erro
Dim objcontrole As Object
For Each objcontrole In Controls
If TypeOf objcontrole Is TextBox Then
If objcontrole.Tag <> 0 Then
objcontrole.ForeColor = vbRed
objcontrole.Locked = False
End If
End If
Next
Exit Sub
Trata_Erro: MensagensDeErro
End Sub

Private Sub Command1_Click()
On Error GoTo Trata_Erro
MsgBox [Ô] Voce esta saindo da AGENDA[Ô], vbInformation, [Ô]AVISO[Ô]
Unload Me
End
Exit Sub
Trata_Erro: MensagensDeErro
End Sub

Private Sub Command2_Click()
On Error GoTo Trata_Erro
Limpa_Campos
Command1.Visible = False
Command2.Visible = False
Command3.Visible = False
Command4.Visible = False
Command5.Visible = True
Command6.Visible = False
Command7.Visible = False
Text1.Visible = False
MSFlexGrid1.Visible = False
txtEmpresa.SetFocus
Call Destravatela
Exit Sub
Trata_Erro: MensagensDeErro
End Sub

Private Sub Command3_Click()
On Error GoTo Trata_Erro
DataAgenda.rsComRegistro.Filter = [Ô]Nome=[ô][Ô] & txtNome.Text & [Ô][ô][Ô]
RegistroUnico.Show
Exit Sub
Trata_Erro: MensagensDeErro
End Sub

Private Sub Command5_Click() [ô] salvar
On Error GoTo Trata_Erro
Set adoDataConn = New ADODB.Connection
adoDataConn.Open [Ô]Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Agenda\Agenda.mdb;Persist Security Info=False[Ô]
Set rsMySQL = New ADODB.Recordset
rsMySQL.Open [Ô]Agenda[Ô], adoDataConn, 1, 3
If txtEmpresa.Text = [Ô][Ô] Then [ô] txtempresa
MsgBox [Ô] Atenção voce não digitou o NOME da EMPRESA, Favor digitar agora ??, ou colocar X[Ô], vbInformation, [Ô]ATENÇÃO O CAMPO NÃO PODE FICAR VAZIO[Ô]
txtEmpresa.BackColor = vbYellow
txtEmpresa.SetFocus
Exit Sub
End If
txtEmpresa.BackColor = vbWhite
If txtNome.Text = [Ô][Ô] Then [ô] txt nome
MsgBox [Ô] Atenção voce não digitou o NOME, Favor digitar agora ??, ou colocar X[Ô], vbInformation, [Ô]ATENÇÃO O CAMPO NÃO PODE FICAR VAZIO[Ô]
txtNome.BackColor = vbYellow
txtNome.SetFocus
Exit Sub
End If
txtNome.BackColor = vbWhite
If txtEndereço.Text = [Ô][Ô] Then [ô] txtendereço
MsgBox [Ô] Atenção voce não digitou o ENDEREÇO, Favor digitar agora ??, ou colocar X[Ô], vbInformation, [Ô]ATENÇÃO O CAMPO NÃO PODE FICAR VAZIO[Ô]
txtEndereço.BorderStyle = 1
txtEndereço.BackColor = vbYellow
txtEndereço.SetFocus
Exit Sub
End If
If txtBairro.Text = [Ô][Ô] Then [ô] txt bairro
MsgBox [Ô] Atenção voce não digitou o BAIRRO, Favor digitar agora ??, ou colocar X[Ô], vbInformation, [Ô]ATENÇÃO O CAMPO NÃO PODE FICAR VAZIO[Ô]
txtBairro.BackColor = vbYellow
txtBairro.SetFocus
Exit Sub
End If
txtBairro.BackColor = vbWhite
If txtCep.Text = [Ô][Ô] Then [ô] txt cep
MsgBox [Ô] Atenção voce não digitou o CEP, Favor digitar agora ??, ou colocar X[Ô], vbInformation, [Ô]ATENÇÃO O CAMPO NÃO PODE FICAR VAZIO[Ô]
txtCep.BackColor = vbYellow
txtCep.SetFocus
Exit Sub
End If
txtCep.BackColor = vbWhite
If txtCidade.Text = [Ô][Ô] Then [ô]txtcidade
MsgBox [Ô] Atenção voce não digitou o CIDADE, Favor digitar agora ??, ou colocar X[Ô], vbInformation, [Ô]ATENÇÃO O CAMPO NÃO PODE FICAR VAZIO[Ô]
txtCidade.BackColor = vbYellow
txtCidade.SetFocus
Exit Sub
End If
txtCidade.BackColor = vbWhite
If txtEstado.Text = [Ô][Ô] Then [ô] txtestado
MsgBox [Ô] Atenção voce não digitou o ESTADO, Favor digitar agora ??, ou colocar X[Ô], vbInformation, [Ô]ATENÇÃO O CAMPO NÃO PODE FICAR VAZIO[Ô]
txtEstado.BackColor = vbYellow
txtEstado.SetFocus
Exit Sub
End If
txtEstado.BackColor = vbWhite
If txtFone1.Text = [Ô][Ô] Then [ô] txtfone1
MsgBox [Ô] Atenção voce não digitou o FONE, Favor digitar agora ??, ou colocar X[Ô], vbInformation, [Ô]ATENÇÃO O CAMPO NÃO PODE FICAR VAZIO[Ô]
txtFone1.BackColor = vbYellow
txtFone1.SetFocus
Exit Sub
End If
txtFone1.BackColor = vbWhite
If txtFone2.Text = [Ô][Ô] Then [ô] txtfone2
MsgBox [Ô] Atenção voce não digitou o FONE 2, Favor digitar agora ??, ou colocar X[Ô], vbInformation, [Ô]ATENÇÃO O CAMPO NÃO PODE FICAR VAZIO[Ô]
txtFone2.BackColor = vbYellow
txtFone2.SetFocus
Exit Sub
End If
txtFone2.BackColor = vbWhite
If txtCelular.Text = [Ô][Ô] Then [ô]txtcelular
MsgBox [Ô] Atenção voce não digitou o CELULAR, Favor digitar agora ??, ou colocar X[Ô], vbInformation, [Ô]ATENÇÃO O CAMPO NÃO PODE FICAR VAZIO[Ô]
txtCelular.BackColor = vbYellow
txtCelular.SetFocus
Exit Sub
End If
txtCelular.BackColor = vbWhite
If txtObs.Text = [Ô][Ô] Then [ô]txtObs
MsgBox [Ô] Atenção voce não digitou o OBS., Favor digitar agora ??, ou colocar X[Ô], vbInformation, [Ô]ATENÇÃO O CAMPO NÃO PODE FICAR VAZIO[Ô]
txtObs.BackColor = vbYellow
txtObs.SetFocus
Exit Sub
End If
txtObs.BackColor = vbWhite
Command1.Visible = True
Command4.Visible = True
Text1.Visible = True
MSFlexGrid1.Visible = False
If txtCódigo.Text = [Ô][Ô] Then [ô] codigo novo
rsMySQL.AddNew
txtCódigo.Text = rsMySQL([Ô]Código[Ô])
rsMySQL([Ô]Empresa[Ô]) = txtEmpresa.Text
rsMySQL([Ô]Nome[Ô]) = txtNome.Text
rsMySQL([Ô]Endereço[Ô]) = txtEndereço.Text
rsMySQL([Ô]Bairro[Ô]) = txtBairro.Text
rsMySQL([Ô]Cep[Ô]) = txtCep.Text
rsMySQL([Ô]Cidade[Ô]) = txtCidade.Text
rsMySQL([Ô]Estado[Ô]) = txtEstado.Text
rsMySQL([Ô]Fone1[Ô]) = txtFone1.Text
rsMySQL([Ô]Fone2[Ô]) = txtFone2.Text
rsMySQL([Ô]Celula[Ô]) = txtCelular.Text
rsMySQL([Ô]Email[Ô]) = Text3.Text
rsMySQL([Ô]Radio[Ô]) = Text4.Text
rsMySQL([Ô]Obs[Ô]) = txtObs.Text
Else
Dim strCod As String
With rsMySQL [ô] pesquisa de codigo
strCod = txtCódigo.Text
If strCod = [Ô][Ô] Then Exit Sub
Command5.Tag = .AbsolutePosition
.Find [Ô]Código=[ô][Ô] & strCod & [Ô][ô][Ô]
If .EOF And .BOF Then
.AbsolutePosition = Command5.Tag
Exit Sub
End If
rsMySQL([Ô]Empresa[Ô]) = txtEmpresa.Text
rsMySQL([Ô]Nome[Ô]) = txtNome.Text
rsMySQL([Ô]Endereço[Ô]) = txtEndereço.Text
rsMySQL([Ô]Bairro[Ô]) = txtBairro.Text
rsMySQL([Ô]Cep[Ô]) = txtCep.Text
rsMySQL([Ô]Cidade[Ô]) = txtCidade.Text
rsMySQL([Ô]Estado[Ô]) = txtEstado.Text
rsMySQL([Ô]Fone1[Ô]) = txtFone1.Text
rsMySQL([Ô]Fone2[Ô]) = txtFone2.Text
rsMySQL([Ô]Celula[Ô]) = txtCelular.Text
rsMySQL([Ô]Email[Ô]) = Text3.Text
rsMySQL([Ô]Radio[Ô]) = Text4.Text
rsMySQL([Ô]Obs[Ô]) = txtObs.Text
End With
End If
rsMySQL.Update
Command1.Visible = True
Command2.Visible = True
Command3.Visible = True
Command4.Visible = True
Command5.Visible = False
Command6.Visible = True
Command7.Visible = True
Label5.Visible = False
TravaTela
MsgBox [Ô]Operação realizada com sucesso ![Ô], vbInformation, [Ô]Salvar[Ô]
rsMySQL.Close
adoDataConn.Close
Exit Sub
Trata_Erro: MensagensDeErro
End Sub

Sub Limpa_Campos()
On Error GoTo Trata_Erro
txtCódigo.Text = [Ô][Ô]
txtEmpresa.Text = [Ô][Ô]
txtNome.Text = [Ô][Ô]
txtEndereço.Text = [Ô][Ô]
txtBairro.Text = [Ô][Ô]
txtCep.Text = [Ô][Ô]
txtCidade.Text = [Ô][Ô]
txtEstado.Text = [Ô][Ô]
txtFone1.Text = [Ô][Ô]
txtFone2.Text = [Ô][Ô]
txtCelular.Text = [Ô][Ô]
Text3.Text = [Ô][Ô]
Text4.Text = [Ô][Ô]
txtObs.Text = [Ô][Ô]
Exit Sub
Trata_Erro: MensagensDeErro
End Sub

Private Sub Command6_Click() [ô] editar
On Error GoTo Trata_Erro
Destravatela
Command1.Visible = False
Command2.Visible = False
Command3.Visible = False
Command4.Visible = False
Command5.Visible = True
Command6.Visible = False
Command7.Visible = False
Text1.Visible = False
MSFlexGrid1.Visible = False
Exit Sub
Trata_Erro: MensagensDeErro
End Sub

Private Sub Command4_Click()
On Error GoTo Trata_Erro
Ajuda.Show
Exit Sub
Trata_Erro: MensagensDeErro
End Sub

Private Sub Command7_Click()
On Error GoTo Trata_Erro
RegistroGeral.Show
Exit Sub
Trata_Erro: MensagensDeErro
End Sub

Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
SendKeys [Ô]{tab}[Ô]
KeyAscii = 0
End If
Exit Sub
End Sub

Sub Carrega_Campos()
On Error GoTo Trata_Erro
Set adoDataConn = New ADODB.Connection
adoDataConn.Open [Ô]Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Agenda\Agenda.mdb;Persist Security Info=False[Ô]
Set rsMySQL = New ADODB.Recordset
rsMySQL.Open [Ô]Agenda[Ô], adoDataConn, 1, 3
txtCódigo.Text = rsMySQL!Código
txtEmpresa.Text = rsMySQL!Empresa
txtNome.Text = rsMySQL!Nome
txtEndereço.Text = rsMySQL!Endereço
txtBairro.Text = rsMySQL!Bairro
txtCep.Text = rsMySQL!Cep
txtCidade.Text = rsMySQL!Cidade
txtEstado.Text = rsMySQL!Estado
txtFone1.Text = rsMySQL!Fone1
txtFone2.Text = rsMySQL!Fone2
txtCelular.Text = rsMySQL!Celula
Text3.Text = rsMySQL!Email
Text4.Text = rsMySQL!Radio
txtObs.Text = rsMySQL!Obs
rsMySQL.Close
adoDataConn.Close
Exit Sub
Trata_Erro: MensagensDeErro
End Sub

Private Sub Form_Load()
On Error GoTo Trata_Erro
Left = (Screen.Width - Width) \ 2
Top = (Screen.Height - Height) \ 2
MSFlexGrid1.ColWidth(0) = 600
MSFlexGrid1.ColWidth(1) = 2350
MSFlexGrid1.ColWidth(2) = 2800
MSFlexGrid1.TextMatrix(0, 0) = [Ô]Código[Ô]
MSFlexGrid1.TextMatrix(0, 1) = [Ô]Empresa[Ô]
MSFlexGrid1.TextMatrix(0, 2) = [Ô]Nome[Ô]
MSFlexGrid1.Visible = False
Command5.Visible = False
txtCódigo.Enabled = False
Carrega_Campos
Call TravaTela
Exit Sub
Trata_Erro: MensagensDeErro
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Trata_Erro
Set cnn = Nothing
Exit Sub
Trata_Erro: MensagensDeErro
End Sub

Private Sub MSFlexGrid1_Click()
On Error GoTo Trata_Erro
Set adoDataConn = New ADODB.Connection
adoDataConn.Open [Ô]Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Agenda\Agenda.mdb;Persist Security Info=False[Ô]
Set rsMySQL = New ADODB.Recordset
rsMySQL.Open [Ô]Agenda[Ô], adoDataConn, 1, 3
With rsMySQL [ô] busca
Dim strCod As String
strCod = MSFlexGrid1.TextMatrix(MSFlexGrid1.Row, 0)
If strCod = [Ô][Ô] Then
MARCELO.TREZE 23/08/2013 19:12:36
#428038
colega vc postou o código todo mas em que linha o erro ocorre
GUGU4700 24/08/2013 10:11:15
#428051
é justamente aqui.:

Private Sub Text1_Change()
On Error GoTo Trata_Erro

MSFlexGrid1.ColWidth(0) = 600
MSFlexGrid1.ColWidth(1) = 2350
[txt-color=#0000f0]MSFlexGrid1.ColWidth(2) = 2800
MSFlexGrid1.TextMatrix(0, 0) = [Ô]Código[Ô]
MSFlexGrid1.TextMatrix(0, 1) = [Ô]Empresa[Ô]
MSFlexGrid1.TextMatrix(0, 2) = [Ô]Nome[Ô][/txt-color]

MSFlexGrid1.Visible = True
If Text1.Text = [Ô][Ô] Then
MSFlexGrid1.Enabled = False
vCodigo = [Ô][Ô]
vNome = [Ô][Ô]
Else
MSFlexGrid1.Enabled = True
End If
If Text1.Text = [Ô][Ô] Then
MSFlexGrid1.Rows = 2
MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 0) = [Ô][Ô]
MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 1) = [Ô][Ô]
MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 2) = [Ô][Ô]
MSFlexGrid1.Rows = MSFlexGrid1.Rows - 1
Me.Caption = [Ô]NOME ENCONTRADO é [ô][Ô] & txtNome.Text & [Ô][ô] [Ô]
Exit Sub
End If
MSFlexGrid1.Rows = 2
Set cnn = New ADODB.Connection
cnn.ConnectionString = _
[Ô]Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Agenda\Agenda.mdb;Persist Security Info=False[Ô]
cnn.Open
Set rsClientes = New ADODB.Recordset
rsClientes.CursorLocation = adUseClient
rsClientes.Open [Ô]SELECT * FROM Agenda WHERE Nome Like [ô]%[Ô] & Text1.Text & [Ô]%[ô][Ô], cnn, adOpenStatic, adLockOptimistic
Do While Not rsClientes.EOF
MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 0) = rsClientes.Fields(0).Value
MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 1) = rsClientes.Fields(1).Value
MSFlexGrid1.TextMatrix(MSFlexGrid1.Rows - 1, 2) = rsClientes.Fields(2).Value
MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1
rsClientes.MoveNext
Loop
MSFlexGrid1.Rows = MSFlexGrid1.Rows - 1
regContador = CStr(rsClientes.RecordCount)
If MSFlexGrid1.Rows >= 2 Then
Me.Caption = [Ô] Buscar CADASTRO POR NOME - [Ô] & regContador & [Ô] NOMES encontrados [Ô]
Else
Me.Caption = [Ô] Buscar CADASTRO POR NOME - [Ô] & regContador & [Ô] NOMES encontrados[Ô]
MsgBox [Ô] Registro não localizado, digite outra letra ou NOME[Ô], vbInformation, [Ô]ATENÇÃO[Ô]
End If
rsClientes.ActiveConnection = Nothing
cnn.Close
Exit Sub
Trata_Erro: MensagensDeErro
End Sub

Private Sub Text1_Click()
On Error GoTo Trata_Erro
Label5.Visible = False
txtEmpresa.Enabled = False
txtNome.Enabled = False
txtEndereço.Enabled = False
txtBairro.Enabled = False
txtCep.Enabled = False
txtCidade.Enabled = False
txtEstado.Enabled = False
txtFone1.Enabled = False
txtFone2.Enabled = False
txtCelular.Enabled = False
Text3.Enabled = False
Text4.Enabled = False
txtObs.Enabled = False
Command1.Visible = False
Command2.Visible = False
Command3.Visible = False
Command4.Visible = False
Command6.Visible = False
Command7.Visible = False
Call Destravatela
Exit Sub
Trata_Erro: MensagensDeErro
End Sub
[txt-size=1] [/txt-size]

quando vc pede para fazer outra busca com um nome ou letra que não tem no bco de dados, ele volta com erro de 381, ele não le o MSFlexGrid1.TextMatrix ( subscript out of range ), e apresenta o erro 381.por que faz isso.
obrigado pela ajuda.
WIRCAO 27/08/2013 15:26:43
#428181
Tente desse modo: Digite Exit Sub, antes do End If, onde caso não ache nada ele finaliza.
Exemplo:

If MSFlexGrid1.Rows >= 2 Then
Me.Caption = [Ô] Buscar CADASTRO POR NOME - [Ô] & regContador & [Ô] NOMES encontrados [Ô]
Else
Me.Caption = [Ô] Buscar CADASTRO POR NOME - [Ô] & regContador & [Ô] NOMES encontrados[Ô]
MsgBox [Ô] Registro não localizado, digite outra letra ou NOME[Ô], vbInformation, [Ô]ATENÇÃO[Ô]
Exit Sub
End If
Tópico encerrado , respostas não são mais permitidas