COMO PREENCHER UM OBJETO LABEL UTILIZANDO UM RECORDSET

[JJACKLS]

Olá à todos!

Estou utlizando o Modelo de Aplicativo do Cadastro (Versão 3) construído pelo Tomás e adaptando-o para a minha realidade. Quero utilizar um procedimento parecido com o PopulaListBox do formulário de pesquisa. O que pretendo é o seguinte:

- No meu formulário existe um TextBox onde será digitado um número referente ao código do fornecedor;

- Após digitado código, no evento exit do Textbox a informação "Nome do Fornecedor" correspondente ao código digitado (essas informações estarão cadastradas em outra planilha) deverá assumir a propriedade Caption de um Rótulo (Label) localizado no mesmo formulário;

- Como a informação que deverá retornar no label encontra-se num arquivo diferente do que se encontra o formulário, deverão ser abertos uma conexão e um recordset (método semelhante ao utilizado no formulário de pesquisa do Tomás para popular o ListBox).

Bem, essa é a situação que tenho que resolver. Já tentei adaptar de várias formas o código do Tomás mas não consegui sair da estaca zero. Não sei mais nem por onde começar.

Alguém tem alguma sugestão ou já fez algo parecido?

Abraços,

Jackson Luís

[webmaster]

Jackson,

Deixe-me ver se entendi. Você quer que numa tela, que contenham campos respectivos a um determinado cadastro/tabela/planilha e deseja que, ao digitar um de seus dados, no caso, o código, todos os outros campos sejam preenchidos automaticamente, como se fosse um PROCV.

Adicionalmente, os dados estão em um arquivo diferente do que executa o UserForm.

É isso? Se sim, qual a dúvida? O que já conseguiu fazer até o momento?

Abraços

[JJACKLS]

Caro Tomás,

O que eu pretendo é exatamente algo muito similar a função PROCV do excel. Vamos ver se consigo esclarecer melhor:

i) Montei um formulário para cadastro de clientes, sendo que o formulário fica num arquivo (workbook) e a tabela de dados em outro (utilizando do método adotado por você na versão 3 do Aplicativo de Cadastro);

ii) No formulário de cadastro de clientes haverá um campo (textbox) onde deverá ser informada a cidade do cliente, mas acontece que há uma tabela com as cidades pré-cadastradas (num Workbook diferente do formulário de clientes e da tabela de clientes, ou seja, um terceiro arquivo), de forma que, o usuário deverá digitar apenas o código da cidade no textbox;

iii) ao digitar o código da cidade no textbox, minha intenção é criar uma função que verifique se o código está cadastrado na Tabela de Cidades e caso exista ative um Label ao lado do TextBox de forma que a sua Caption (do Label) assuma a descrição do nome da cidade referente ao código digitado.

Tentei adaptar o código que você utiliza no seu formulário de pesquisa. Nele, digita-se a informação nos campos de pesquisa, essa informação é procurada na base de dados e caso encontrada ela alimenta o ListBox(no meu caso preciso que essa informação retorne no Label). Mas não tive sucesso.

Segue a imagem do formulário que estou montando e abaixo o código que adaptei (sem êxito):

Option Explicit

'Constantes para auxiliar na verificação do código

Private caminhoArquivoCidade As String

Private Sub txtCidadeCliente _exit(ByVal Cancelar As MSForms.ReturnBoolean)
Call PopulaLblCidade(txtCidadeCliente.text)
End Sub

Private Sub UserForm_Initialize()
Call DefinePlanilhaCidade
End Sub

Private Sub DefinePlanilhaCidade()
Dim wb As Workbook
Dim caminhoCidade As String
Dim ARQUIVO_CADCIDADE As String
Dim PASTA_CADCIDADE As String

ARQUIVO_ CADCIDADE = Range("ARQUIVO_ CADCIDADE ").Value
PASTA_ CADCIDADE = Range("PASTA_ CADCIDADE ").Value

If ThisWorkbook.Name <> ARQUIVO_ CADCIDADE Then
'Monta a string do caminho completo
If PASTA_ CADCIDADE = vbNullString Or PASTA_ CADCIDADE = "" Then
caminhoCidade = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, vbNullString) & ARQUIVO_ CADCIDADE
Else
If Right(PASTA_ CADCIDADE, 1) = "\" Then
caminhoCidade = PASTA_ CADCIDADE & ARQUIVO_ CADCIDADE
Else
caminhoCidade = PASTA_ CADCIDADE & "\" & ARQUIVO_ CADCIDADE
End If
End If
End If

caminhoArquivoCidade = caminhoCidade

End Sub

Private Sub PopulaLblCidade (ByVal Codigo As String)

On Error GoTo TrataErro

Dim rstcid As ADODB.Recordset
Dim myArray(0) As Variant

Set rstcid = PreencheRstCid(Codigo)

' coloca as linhas do RecordSet num Array, se houver linhas neste
If Not rstcid.EOF And Not rstcid.BOF Then
lblNomeDaCidade.Caption = rstcid.GetRows
Else
lblNomeDaCidade.Caption = “ ”
End If

'fecha o conjunto de regsitros
Set rst = Nothing

TrataSaida:
Exit Sub
TrataErro:
Debug.Print Err.Description & vbNewLine & Err.Number & vbNewLine & Err.Source
Resume TrataSaida
End Sub

Private Function PreencheRstCid (ByVal Codigo As String) As Recordset

On Error GoTo TrataErro

Dim conncid As ADODB.Connection
Dim rstcid As ADODB.Recordset
Dim sqlcid As String
Dim sqlWhereCid As String

Set conn = New ADODB.Connection

conn.ConnectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & caminhoArquivoClientes & ";" & _
"Extended Properties=Excel 12.0"
conn.Open


sql = "SELECT [NomeDaCidade] FROM [CadClientes$]"

Call MontaClausulaWhere(txtCidade.Name, "Codigo", sqlWhere)

'faz a união da string SQL com a cláusula WHERE
If sqlWhereCid <> vbNullString Then
sqlCid = sqlCid & " WHERE " & sqlWhereCid
End If

Set rstcid = New ADODB.Recordset
rstcid.CursorLocation = adUseClient
With rstcid
.ActiveConnection = conncid
.Open sqlcid, conncid, adOpenForwardOnly, _
adLockBatchOptimistic
End With

Set rstcid.ActiveConnection = Nothing

' Fecha a conexão.
conncid.Close

Set PreencheRecordSet = rstcid
Exit Function
TrataErro:
Set rstcid = Nothing
End Function

Private Sub MontaClausulaWhere(ByVal NomeControle As String, ByVal NomeCampo As String, ByRef sqlWhereCid As String)
'Argumento
If Trim(Me.Controls(NomeControle).Text) <> vbNullString Then
If sqlWhereCid <> vbNullString Then
sqlWhereCid = sqlWhereCid & " AND"
End If
sqlWhereCid = sqlWhereCid & " UCASE(" & NomeCampo & ") LIKE UCASE('%" & Trim(Me.Controls(NomeControle).Text) & "%')" & " AND"
End If
End Sub


Conseguiu entender a minha necessidade? Conhece alguma solução? Tenho vasculhado a internet e não encontrei nada parecido.

Saudações,

Jackson Luís Silva

[Mauro Coutinho]

Jackson, se entendi corretamente, no Tópico TUTORIAIS anexei um exemplo aonde trabalhamos com vários Dados provenientes de outros BD, inclusive Graficos, sem utilizar o Recordset, baixe o exemplo e de uma olhada se é isto que pretende.

Modelo Cadastro V3 - Acesso a outros BD + Graficos
viewtopic.php?f=16&t=633

[]s

[webmaster]

Jackson,

Recomendo dar uma olhada no exemplo do Mauro. Caso não atenda, o que acho difícil, continuamos com a discussão aqui.

Abraços

[JJACKLS]

Boa tarde,Tomás e Mauro!

Agradeço a sua sugestão de vocês, aliás, olhei os modelos citados. A questão é que com certeza existem outras formas de conseguir o que pretendo de forma similar, mas que no momento, gostaria de atingir através da conexão ADO do Excel.

Reformulei o meu código (ele não dá nenhuma mensagem de erro e atráves de testes num List que criei só para teste eu verifiquei que RecordSet está sendo carregado, mas ainda não consigo que a informação apareça no Label). Peço que dêem uma olhada e verifiquem se conseguem entendê-lo e corrigí-lo para atender a situação que solicitei.
______________________________________________________________________________
Option Explicit

Private caminhoArquivoCidade As String

Private Sub txtCidadeCliente_Exit()
Call LabelCidade
End Sub
______________________________________________________________________________
Private Sub UserForm_Initialize()
Call DefinePlanilhaCidade
End Sub
______________________________________________________________________________
Private Sub DefinePlanilhaCidade()
Dim wb As Workbook
Dim caminhoCidade As String
Dim ARQUIVO_CADCIDADE As String
Dim PASTA_CADCIDADE As String

ARQUIVO_CADCIDADE = Range("ARQUIVO_CADCIDADE").Value
PASTA_CADCIDADE = Range("PASTA_CADCIDADE").Value

If ThisWorkbook.Name <> ARQUIVO_CADCIDADE Then
'Monta a string do caminho completo
If PASTA_CADCIDADE = vbNullString Or PASTA_CADCIDADE = "" Then
caminhoCidade = Replace(ThisWorkbook.FullName, ThisWorkbook.Name, vbNullString) & ARQUIVO_CADCIDADE
Else
If Right(PASTA_CADCIDADE, 1) = "\" Then
caminhoCidade = PASTA_CADCIDADE & ARQUIVO_CADCIDADE
Else
caminhoCidade = PASTA_CADCIDADE & "\" & ARQUIVO_CADCIDADE
End If
End If
End If

caminhoArquivoCidade = caminhoCidade

End Sub
________________________________________________________________________________________
Private Sub LabelCidade(ByVal Codigo As String, _
ByVal NomeDaCidade As String)

On Error GoTo TrataErro

Dim connCid As ADODB.Connection
Dim rstCid As ADODB.Recordset
Dim sqlCid As String
Dim CodCid As String
Dim DescCidade As String

CodCid = txtCidadeCliente.Text

Set connCid = New ADODB.Connection

connCid.ConnectionString = _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & caminhoArquivoCidade & ";" & _
"Extended Properties=Excel 12.0"
connCid.Open


sqlCid = "SELECT * FROM [CadCidade$] WHERE [Codigo] = '" & CodCid & "'"

Set rstCid = New ADODB.Recordset
rstCid.CursorLocation = adUseClient
With rstCid
.ActiveConnection = connCid
.Open sqlCid, connCid, adOpenForwardOnly, _
adLockBatchOptimistic
End With


If rstCid.EOF = False And Not rstCid.BOF Then
DescCidade = rstCid.Fields("NomeDaCidade")
lblNomeDaCidade.Caption = DescCidade
Else
lblNomeDaCidade.Caption = " "
End If

Set rstCid.ActiveConnection = Nothing

' Fecha a conexão.
connCid.Close

Exit Sub
TrataErro:
Set rstCid = Nothing
End Sub

Desde já, agradeço a colaboração. Saudações,

Jackson

[Mauro Coutinho]

Jackson, pelo que vi sua rotina foi construida em cima do Excel 2007, e como não possuo esta versão não pude testa-la, mas acho que se alterar a linha linha abaixo irá funcionar :

esta :
sqlCid = "SELECT * FROM [CadCidade$] WHERE [Codigo] = '" & CodCid & "'"

Por esta, sem os Apóstrofos ( ' ) :
sqlCid = "SELECT * FROM [CadCidade$] WHERE [Codigo] = " & CodCid & ""

Se não, fiz uma adaptação do Modelo do Tomas V3, no Excel 2003, que acredito seja o que está pretendendo :
Digitar no TextBox o numero da CIDADE e retornar em um Label o NOME da mesma se existir, se não deixa-lo em branco.

No anexo descompacte as duas pastas no mesmo diretorio e faça os testes se seria isso mesmo e depois readapte a sua com a versão do 2007.

Uma ótima referencia que costumo me basear é no link abaixo :
http://www.w3schools.com/sql/default.asp

Anexo Atualizado em 03/05/2011

RelCodCidades.rar

(26.86 KiB) Baixado 413 vezes

[]s

[JJACKLS]

Mauro,

Você tinha razão. Retirei os Apóstrofos ( ' ) e o procedimento foi executado como pretendido.

Agradeço a colaboração e mais uma vez parabenizo você e o Tomáz pela grande contribuição não só para mim mas para todos que participam dessa comunidade.

Até próxima. Abraços,

Jackson