[Resolvido]Formulario que exiba todos os registros em Caixas de Texto.

Boa noite, amigos do Forum.

Estou querendo fazer um SubFormulario, baseado em uma consulta, que exiba todos os registros ao mesmo tempo, em caixas de texto, colocadas lado-a-lado. Os dados exibidos são numéricos com 4 digitos cada. Seria possível fazer isso?
No anexo envio uma imagem da Tela que estou tentando desenvolver. Os dois graficos estão funcionando a contento, mas as "Familias Cadastradas por Prontuário" não sei como fazer.

Um abraço.
Walter

Bom dia Harysohn.

No anexo envio o arquivo, ou melhor, parte do arquivo, para voce analisar.
Veja o formulario Fml_TelaInicial. Nele tem dois graficos que funcionam com dados vindos de duas consultas diferentes. Estão funcionando certinho... Mas o quadro à esquerda com várias caixas de texto não-acopladas, abaixo do titulo: "Familias Cadastradas com Nº do Prontuário", eu gostaria que os números dos prontuários captados pela consulta "Cnslt_ProntuariosCadastrados" fossem para essas caixas de texto, em ordem crescente... Deixei alguns registros que tem os números de prontuários: 131-138-144-242-401-714, etc.
Ficou claro o que pretendo?

Walter

Inda não.... Seja um pouco mais claro por gentileza.

Cumprimentos.

Bom dia Walter, o banco que mandaste falta tabelas ou consultas, reenvie novamente por gentileza.

Cumprimentos.

Bom dia, Harysohn.
Desculpe o engano...
Agora acho que vai certo.
Abra no Formulário Fml_TelaInicial. Coloquei uma informação em letras amarelas.

Walter

Ok compreendi...Apenas necessito uma pequena ajuda tua para agilizar a solução...

Seguindo a ordem da esquerda para direita e ao final continuando na proxima linha abaixo... Renomeeie as caixas texto para a seguinte nomeclatura

tx1, tx2, tx3....
txn,txy, txi

onde n, y e i são a sequencia da numeração da linha superior das caixas texto.

Acuse se compreendeu, caso positivo renomeie as caixas texto com esta disposição e me reenvie o arquivo.

Aguardo.

Cumprimentos.

Olá, Harysohn.

Ufa! Consegui renomear as caixas de Texto, mas deu um trabalhão!
Peço desculpa pela demora, é que estou de plantão nesses dias de festa e a coisa complicou.

Aí vai o arquivo. Espero que seja assim mesmo.

  hehehe.. Por isso te pedi rsrs

Logo mais farei isto pra ti.

Cumprimentos.

Eis:

Dim X As Integer
Dim Rs As DAO.Recordset
Dim StrSQL As String

StrSQL = "SELECT Tbl_Titular.CódigoTitular, Tbl_Titular.Prontuário FROM Tbl_Titular ORDER BY Tbl_Titular.Prontuário"

Set Rs = CurrentDb.OpenRecordset(StrSQL)
Rs.MoveLast: Rs.MoveFirst

For X = 1 To Rs.RecordCount
Me("tx" & X).Value = Rs!Prontuário
Rs.MoveNext
Next

Observe que utilizo o For para que possa modificar o objeto que receberá o registro do recordset, concatenando o Tx com o x
X será a quantidade de registros na tbl_titular


Cumprimentos.

Muito bem, Haryshon.
Funcionou legal, aqui. Quanto ao comentário no final do código não entendi nada, pois meus conhecimentos em VBA são muito rudimentares ainda...

Por sinal: Veja que na Tbl_Titular tem os campos "CódigoTitular" e "CódigoACS". Teria como implementar nesse código alguma coisa que permita que seja realizadas duas coisas:
1) Ao clicar duas vezes na caixa de texto abra o "Fml_CadastroFamilias" no Prontuário correspondente.
2) Formatação condicional, usando VBA para colorir o fundo da caixa de texto em função do "CódigoACS". São 6 (seis) ACS: (B07, B08, B09, B10, B11, B12). Queria que cada um tivesse uma cor que o identificasse...

(Tô pedindo muito?)

Um abraço.
Walter

Claro... De mais detalhes apenas.

Cumprimentos.

Boas Walter.. o código para o clique é o a seguir..
Só um porém...

Aqui só funcionou para o Primeiro quadro.. para os demais produz erro no Access... Isto não deveria acontecer pois o código está correto..
Pode ser que o Banco que está o teu sistema está com algo corrompido..

Importe tudo para um novo banco e teste.. ou então faça uma copia do formulário de cadastro de familias apenas para este uso.

Private Sub tx1_Click()
Dim lngFam As Long
lngFam = DLookup("CódigoTitular", "Cnslt_ProntuáriosCadastrados", "Prontuário = " & CLng(Me.tx1) & "")
DoCmd.OpenForm "Fml_CadastroFamilias", , , "CódigoTitular = " & lngFam & ""
End Sub

Private Sub tx2_Click()
Dim lngFam As Long
lngFam = DLookup("CódigoTitular", "Cnslt_ProntuáriosCadastrados", "Prontuário = " & CLng(Me.tx2) & "")
DoCmd.OpenForm "Fml_CadastroFamilias", , , "CódigoTitular = " & lngFam & ""
End Sub

Private Sub tx3_Click()
Dim lngFam As Long
lngFam = DLookup("CódigoTitular", "Cnslt_ProntuáriosCadastrados", "Prontuário = " & CLng(Me.Tx3) & "")
DoCmd.OpenForm "Fml_CadastroFamilias", , , "CódigoTitular = " & lngFam & ""
End Sub

Esta ai para as 3 primeiras.

Cumprimentos.

Boa tarde Walter.. uma correção

Altere o código para o seguinte.

Dim X As Integer
Dim Rs As DAO.Recordset
Dim StrSQL As String

StrSQL = "SELECT Tbl_Titular.CódigoTitular, Tbl_Titular.Prontuário FROM Tbl_Titular ORDER BY Tbl_Titular.Prontuário"

Set Rs = CurrentDb.OpenRecordset(StrSQL)
Rs.MoveLast: Rs.MoveFirst

For X = 1 To Rs.RecordCount
Me("tx" & X) = Rs!Prontuário
Rs.MoveNext
Next

Apenas retirei o .Value da linha a seguir.. Isto produzia o Erro:

Me("tx" & X).Value = Rs!Prontuário

Cumprimentos.

Boa noite, Haryshon.

Alguma coisa não deu certo. Ao clicar na caixa de texto o Formulario abre, mas não abre no registro correspondente.
Será que não fiz corretamente?

Veja:

Vamos la Amigão.

Primeiro, não consegui descobrir o porque... Porém o access está dando erro mesmo se eu utilizar a leitura do conteúdo de uma das caixas texto em uma MsgBox, por exemplo:

MsgBox Me.tx1

Era para exibir em mensagem o conteúdo da caixa texto tx1, porém ao executar o código gera erro grave no access e o fecha.

Para resolver isto além de carregar as caixas textos carrego também uma matriz com o nome da caixa texto e o o numero do prontuário para ai sim extrair o seu conteúdo... Exemplo:

Ao carregar a caixa texto tx1, Carrego a Matriz K na sua posição 1 com o prontuário da caixa texto tx1...
Portanto se tx1 = 98,  k(1) = 98
            se tx2 = 737  k(2) = 737

Utilizo portanto a Matriz ao invés da caixa texto no Dlookup para abrir o formulário. Criei uma sub para facilitar este processo


==================================================


Nas declarações do módulo do form:
Option Compare Database
Dim K

No Evento ao carregar do Form (observe que está com código para pintar o controle de acordo com o acs):
Dim X As Integer
Dim Rs As DAO.Recordset
Dim StrSQL As String
Dim nCount As Long
Dim StrCor As Long
StrSQL = "SELECT Tbl_Titular.CódigoTitular, Tbl_Titular.Prontuário FROM Tbl_Titular ORDER BY Tbl_Titular.Prontuário"

Set Rs = CurrentDb.OpenRecordset(StrSQL)

Rs.MoveLast: Rs.MoveFirst
'Redimensiono a Matriz para conter o número de registros do recordset
ReDim K(Rs.RecordCount)
'Utilizo o Loop com o For para carregar as caixas textos e a Matriz
For X = 1 To Rs.RecordCount
Me("tx" & X) = Rs!Prontuário
K(X) = CLng(Rs!Prontuário)
Rs.MoveNext
StrCor = Nz(DLookup("cpCor", "tbl_ACS", "CódigoACS = '" & DLookup("CódigoACS", "Tbl_Titular", "Prontuário= " & K(X) & "") & "'"), "0")
Me("tx" & X).ForeColor = StrCor
Next

Crie uma sub:
Sub AbreForm()
Dim X
Dim NumPront As Long
X = CLng(Mid(Me.ActiveControl.Name, 3, Len(Me.ActiveControl.Name)))
NumPront = DLookup("CódigoTitular", "Tbl_Titular", "Prontuário= " & K(X) & "")
DoCmd.OpenForm "Fml_CadastroFamilias", , , "CódigoTitular= " & NumPront & ""
End Sub


No Comando Click da caixa texto apenas:
Me.AbreForm

Para o colorimento da caixa texto de acordo com o ACS

Crie na tabela Tbl_Acs um campo e nomeie de cpCor
Neste colocará a cor que deseja que tenha o ACS...
Esta coloração será expressa em números de acordo com a última coluna do .doc em anexo

https://dl.dropboxusercontent.com/u/26441349/RGB_VBA.rar


Portanto ao abrir o formulário na parte do código no evento ao carregar expresso abaixo, carregará em uma variável a cor do ACS e pintará o controle de acordo com o ACS (O código abaixo é apenas para sua compreensão do processo e está embutido no código acima que carrega os controles)


StrCor = Nz(DLookup("cpCor", "tbl_ACS", "CódigoACS = '" & DLookup("CódigoACS", "Tbl_Titular", "Prontuário= " & K(X) & "") & "'"), "0")
Me("tx" & X).ForeColor = StrCor

Boa tarde, Haryshon

Passei alguns dias viajando e não pude testar suas sugestões...
Agora, ao testar, vi que o "colorimento" da caixa de texto funciona legal. Muito bem! Mas o Formulario abre-se em branco ao clicar sobre a caixa de texto...
A sub abaixo parece não estar chamando o registro referente à caixa de texto (o prontuário)

Sub AbreForm()
Dim X
Dim NumPront As Long
X = CLng(Mid(Me.ActiveControl.Name, 3, Len(Me.ActiveControl.Name)))
NumPront = DLookup("CódigoTitular", "Tbl_Titular", "Prontuário= " & K(X) & "")
DoCmd.OpenForm "Fml_CadastroFamilias", , , "CódigoTitular= " & NumPront & ""
End Sub

Será que fiz algo errado?

Um abraço,

Walter

Bom dia Walter... Manda ai o BD para que eu possa ver.
Amigão manda o exemplo para corrigir aqui.. e no meu e-mail o modelo completo, necessito apresentar ao secretário.

Cumprimentos.

Bom dia, Harysohn.
Não estou conseguindo compactar o arquivo com Winzip e o Winrar não é aceito pelo Forum.
Abaixo envio o link no Dropbox, para voce tentar abrir. Vou fazer o mesmo com o aplicativo completo, para o seu e-mail, até que consiga configuara o Winzip aqui.

https://www.dropbox.com/s/08myqgzahzptji4/TelaInicial.mdb


Consegui compactar:

Boa tarde Walter..
O teu formulário está configurado apra abrir em um registro novo.. portanto ele filtra e vai para um novo registro..

Abra o frm em modo design, vá em propriedades, aba dados, Entrada de Dados = não.

Cumprimentos.

Perfeito, Haryshon.

Funcionou direitinho como eu queria.

Muito obrigado, mais uma vez...

(Conseguiu adaptar o Aplicativo para apresentar na Prefeitura? Se precisar de algum esclarecimento, por favor, faça contato. Ajudarei no que puder, ok?)

Um abraço

Walter

Sim amigo. precisando te dou um alô.

o Fórum agradece o Retorno.