[Resolvido]Preencher campos vazios de varios registros em tabela

Estou de novo aqui a pedir apoio em uma nova solução para meu projeto recente.

Eu preciso criar uma consulta  Dlookup VBA que compare a data e o item no formulário com registros já existentes em uma tabela.
Após essa consulta a mesma autorize o preenchimento de campos vazios conforme campos que eu desecriminar no form.


Exemplo:
Public Sub btnAtualizar()
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb
Dat = Format(Me.data, "mm/dd/yyyy")
tipo = item1

Set rs = db.OpenRecordset("Select * from tbRegistros Where  ItemD= '" & tipo & "' and Data =#" & Dat & "#")
rs.Edit
rs("ItemN") = item1.Value
'rs("DescricaoN") = Me("falha" & I).Value

rs.Update
rs.Close
db.Close

End Sub


Eu necessito que al[em do campo individual do formulario ele copie varias linhas da tabela.

Resulte nisso...
Campos Tabela/Formulario:
ItemN = Me("item" & I).
FalhaN = Me("falha" & I).

Tente assim :

Public Sub btnAtualizar()

Dim db As Database
Dim rs As Recordset
Set db = CurrentDb
Dat = Format(Me.data, "mm/dd/yyyy")
tipo = item1

Set rs = db.OpenRecordset("Select * from tbRegistros Where ItemD= '" & tipo & "' and Data =#" & Dat & "#")

If ItemD= '" & tipo & "' and Data =#" & Dat & "#" then

rs.Edit
rs("ItemN") = item1.Value
'rs("DescricaoN") = Me("falha" & I).Value

rs.Update
rs.Close

End If

db.Close


End Sub

Verifique os nomes dos campos tanto da tabela quanto do formulário.

Abraços

Desculpas, não havia percebido esta parte:

Eu necessito que al[em do campo individual do formulario ele copie varias linhas da tabela.

Terei alterar o código, assim que conseguir posto.

Abraços

Olá,

Talvez seja isso:

Set rs = db.OpenRecordset("Select * from tbRegistros Where  ItemD= '" & tipo & "' and Data =#" & Dat & "#")
Do While Not rs.EOF
rs.Edit
rs("ItemN") = item1.Value
'rs("DescricaoN") = Me("falha" & I).Value
rs.Update
rs.MoveNext
Loop
rs.Close
db.Close

Não funcionou dessa forma...

Set rs = db.OpenRecordset("Select * from tbRegistros Where ItemD='" & tipo & "' And Format$(Data, 'mm/dd/yyyy') ='" & Dat & "'")

Então voltando a analisar eu preciso do seguinte.

"tbRegistros" tem 23 campos.


Eu tenho um formulário que efetua cadastro via VBA (rs) para "tbRegistros" preenchendo 13 campos.
A qual irá cadastrar  15 linhas (uma linha para cada item - com a regra I)

O mesmo formulário deve atualizar com os critérios "Data" & "Item" os outros 10 campos faltantes de cada item cadastrados anteriormente.


Já tentei de varias formas. Infelizmente ele só atualiza a primeira linha cadastrada na tabela.

Código:

Public Sub btnAtualizar()
Dim Dat As String
Dim tipo As String
Dim db As Database
Dim rs As Recordset
Dim rs1 As Recordset
Dim Item As String
Dim I As Integer, Preenchidos As Boolean


For I = 1 To 2
If Len("" & Me("txtItem" & I)) > 0 Then
Preenchidos = True
End If
Next

Dat = Format(Me.data, "mm/dd/yyyy")
Item = txtItem


Set db = CurrentDb
Set rs = db.OpenRecordset("Select * from tbRegistros Where  CódigoItem= '" & Item & "' and Data =#" & Dat & "#")
rs.Edit
rs("ItemN") = Me("item" & I).Value
rs("DescricaoN") = Me.falha1.Value
rs("ResponsavelN") = Me.nome.Value
rs("TurmaN") = Me.turma.Value
rs("IDN") = Me.ID.Value
rs("TurnoN") = Me.turno.Value

If Me.hora1 = 1 Then rs("hora20") = "Ruim"
If Me.hora1 = 2 Then rs("hora20") = "Regular"
If Me.hora1 = 3 Then rs("hora20") = "Bom"

If Me.horaa1 = 1 Then rs("hora23") = "Ruim"
If Me.horaa1 = 2 Then rs("hora23") = "Regular"
If Me.horaa1 = 3 Then rs("hora23") = "Bom"

If Me.horaaa1 = 1 Then rs("hora02") = "Ruim"
If Me.horaaa1 = 2 Then rs("hora02") = "Regular"
If Me.horaaa1 = 3 Then rs("hora02") = "Bom"

If Me.horaaaa1 = 1 Then rs("hora05") = "Ruim"
If Me.horaaaa1 = 2 Then rs("hora05") = "Regular"
If Me.horaaaa1 = 3 Then rs("hora05") = "Bom"



rs.Update

rs.Close
db.Close


Set db = CurrentDb
Set rs1 = db.OpenRecordset("Select * from tblStatus Where  Equipamento= '" & Me.Equip & "' and Data =#" & Dat & "#")
rs1.Edit
rs1("Hora20") = Me.Status8.Value
rs1("Hora23") = Me.Status11.Value
rs1("Hora02") = Me.Status14.Value
rs1("Hora05") = Me.Status17.Value

rs1.Update

rs1.Close
db.Close




End Sub


Tentou com a alteração proposta na minha mensagem anterior?

Set rs = db.OpenRecordset("Select * from tbRegistros Where ItemD='" & tipo & "' And Format$(Data, 'mm/dd/yyyy') ='" & Dat & "'")

Não fuinciona do jeito que espero.

O problema está no código abaixo:

rs.Edit
rs("ItemN") = Me("item" & I).Value

Eu preciso que selecione ele altere varias linhas.

Do jeito que o código está, só vai alterar a primeira linha mesmo.

Para continuar alterando as demais linhas resultantes do select, precisa de um loop, conforme a minha primeira mensagem onde menciono em azul:

Do While Not rs.EOF
...
rs.MoveNext
Loop

Se puder enviar uma cópia do banco de dados, implemento a solução conforme precisa.

Segue projeto

O formulario de cadastro se chama "frmListAL".

O botao registrar, registra e altera itens na tabela "tbRegistros"

Ordem:
Primeiro cadastro é turno "Diurno"
Alteração é turno "Noturno"

Eu alterei o código mais ele não funcionou.

Código:

Public Sub btnAtualizar()

Dim Dat As String
Dim tipo As String
Dim db As Database
Dim rs As Recordset
Dim rs1 As Recordset
Dim Item As String
Dim I As Integer, Preenchidos As Boolean

For I = 1 To 2
    If Len(Me("Item" & I)) > 0 Then
        Preenchidos = True
    End If
Next

Dat = Format(Me.data, "mm/dd/yyyy")
Item = Me!item1

Set db = CurrentDb
Set rs = db.OpenRecordset("Select * from tbRegistros Where ItemD='" & Item & "' And Format$(Data, 'mm/dd/yyyy') ='" & Dat & "'")

Do While Not rs.EOF
    rs.Edit
    rs("ItemN") = Me("item" & I).Value
    rs("DescricaoN") = Me("falha" & I).Value
    rs("ResponsavelN") = Me.nome.Value
    rs("TurmaN") = Me.turma.Value
    rs("IDN") = Me.ID.Value
    rs("TurnoN") = Me.turno.Value
    If Me.hora1 = 1 Then rs("hora20") = "Ruim"
    If Me.hora1 = 2 Then rs("hora20") = "Regular"
    If Me.hora1 = 3 Then rs("hora20") = "Bom"
    
    If Me.horaa1 = 1 Then rs("hora23") = "Ruim"
    If Me.horaa1 = 2 Then rs("hora23") = "Regular"
    If Me.horaa1 = 3 Then rs("hora23") = "Bom"
    
    If Me.horaaa1 = 1 Then rs("hora02") = "Ruim"
    If Me.horaaa1 = 2 Then rs("hora02") = "Regular"
    If Me.horaaa1 = 3 Then rs("hora02") = "Bom"
    
    If Me.horaaaa1 = 1 Then rs("hora05") = "Ruim"
    If Me.horaaaa1 = 2 Then rs("hora05") = "Regular"
    If Me.horaaaa1 = 3 Then rs("hora05") = "Bom"
    
    rs.Update
    rs.MoveNext
Loop

rs.Close
db.Close

Set db = CurrentDb
Set rs1 = db.OpenRecordset("Select * from tblStatus Where  Equipamento= '" & Me.Equip & "' and Data =#" & Dat & "#")
rs1.Edit
rs1("Hora20") = Me.Status8.Value
rs1("Hora23") = Me.Status11.Value
rs1("Hora02") = Me.Status14.Value
rs1("Hora05") = Me.Status17.Value
rs1.Update

rs1.Close
db.Close

MsgBox "Turno B registrado com sucesso"

End Sub

Corrigindo o código ficou assim:

Ele agora está lançando, mas ainda não atendeu, pois só está pegando o útimo registro e lançando em todas as linhas.

Código:

Public Sub btnAtualizar()

Dim Dat As String
Dim tipo As String
Dim db As Database
Dim rs As Recordset
Dim Item As String
Dim I As Integer, Preenchidos As Boolean

For I = 1 To 12
If Len("" & Me("item" & I)) > 0 Then
Preenchidos = True
End If
Next


If Me.nome > 0 And Me.turma > 0 And Me.data > 0 Then


If MsgBox("Confirma Transferência?", vbYesNo + vbQuestion, "CONFIRMAR") = vbNo Then Exit Sub


Set rs = CurrentDb.OpenRecordset("tbRegistros", dbOpenTable)

With rs


Dat = Format(Me.data, "mm/dd/yyyy")


Set db = CurrentDb
Set rs = db.OpenRecordset("Select * from tbRegistros Where Equipamento='" & Equip & "' And Format$(Data, 'mm/dd/yyyy') ='" & Dat & "'")

Do While Not rs.EOF
    rs.Edit
    rs("ItemN") = Me("item" & I).Value
    rs("DescricaoN") = Me("falha" & I).Value
    rs("ResponsavelN") = Me.nome.Value
    rs("TurmaN") = Me.turma.Value
    rs("IDN") = Me.ID.Value
    rs("TurnoN") = Me.turno.Value
    If Me.hora1 = 1 Then rs("hora20") = "Ruim"
    If Me.hora1 = 2 Then rs("hora20") = "Regular"
    If Me.hora1 = 3 Then rs("hora20") = "Bom"
   
    If Me.horaa1 = 1 Then rs("hora23") = "Ruim"
    If Me.horaa1 = 2 Then rs("hora23") = "Regular"
    If Me.horaa1 = 3 Then rs("hora23") = "Bom"
   
    If Me.horaaa1 = 1 Then rs("hora02") = "Ruim"
    If Me.horaaa1 = 2 Then rs("hora02") = "Regular"
    If Me.horaaa1 = 3 Then rs("hora02") = "Bom"
   
    If Me.horaaaa1 = 1 Then rs("hora05") = "Ruim"
    If Me.horaaaa1 = 2 Then rs("hora05") = "Regular"
    If Me.horaaaa1 = 3 Then rs("hora05") = "Bom"
   
    rs.Update
    rs.MoveNext
Loop

rs.Close
db.Close


Set rs = Nothing
MsgBox "Transferência confirmada." & vbCr & vbCr & I & "  registros do Turno B.", vbOKOnly + vbInformation, "com Sucesso"

Não entendi o que quer dizer com "está pegando o útimo registro e lançando em todas as linhas".
Como deve funcionar?
Pode descrever um exemplo?

Seria isso?

Código:

Public Sub btnAtualizar()

Dim Dat As String
Dim tipo As String
Dim db As Database
Dim rs As Recordset
Dim Item As String
Dim I As Integer, Preenchidos As Boolean

For I = 1 To 12
If Len("" & Me("item" & I)) > 0 Then
Preenchidos = True
End If
Next


If Me.nome > 0 And Me.turma > 0 And Me.data > 0 Then


If MsgBox("Confirma Transferência?", vbYesNo + vbQuestion, "CONFIRMAR") = vbNo Then Exit Sub


Set rs = CurrentDb.OpenRecordset("tbRegistros", dbOpenTable)

With rs


Dat = Format(Me.data, "mm/dd/yyyy")


Set db = CurrentDb
Set rs = db.OpenRecordset("Select * from tbRegistros Where Equipamento='" & Equip & "' And Format$(Data, 'mm/dd/yyyy') ='" & Dat & "'")

I = 0
Do While Not rs.EOF
    I = I + 1
    rs.Edit
    rs("ItemN") = Me("item" & I).Value
    rs("DescricaoN") = Me("falha" & I).Value
    rs("ResponsavelN") = Me.nome.Value
    rs("TurmaN") = Me.turma.Value
    rs("IDN") = Me.ID.Value
    rs("TurnoN") = Me.turno.Value
    If Me.hora1 = 1 Then rs("hora20") = "Ruim"
    If Me.hora1 = 2 Then rs("hora20") = "Regular"
    If Me.hora1 = 3 Then rs("hora20") = "Bom"
    
    If Me.horaa1 = 1 Then rs("hora23") = "Ruim"
    If Me.horaa1 = 2 Then rs("hora23") = "Regular"
    If Me.horaa1 = 3 Then rs("hora23") = "Bom"
    
    If Me.horaaa1 = 1 Then rs("hora02") = "Ruim"
    If Me.horaaa1 = 2 Then rs("hora02") = "Regular"
    If Me.horaaa1 = 3 Then rs("hora02") = "Bom"
    
    If Me.horaaaa1 = 1 Then rs("hora05") = "Ruim"
    If Me.horaaaa1 = 2 Then rs("hora05") = "Regular"
    If Me.horaaaa1 = 3 Then rs("hora05") = "Bom"
    
    rs.Update
    rs.MoveNext
Loop

rs.Close
db.Close


Set rs = Nothing
MsgBox "Transferência confirmada." & vbCr & vbCr & I & "  registros do Turno B.", vbOKOnly + vbInformation, "com Sucesso"

Muito bom... era isso mesmo.

São pequenos detalhes que fazem nosso conhecimentos crescerem juntos...

Obrigado Colega.

Belas palavras, Fabrícia.  
Disponha