[Resolvido]salvar multiplos registros subform continuo

Bom dia amigos! Por favor, alguém poderia me dizer como faço para selecionar varias linhas(registros) num subform modo folha de dados e salvar em uma tabela?

Desde já, agradeço imensamente a ajuda dos colegas. Tenho pesquisado muito sobre isso, mas ainda não achei o que precisava.

Os dados do subform saem de uma consulta chama CONSPR. Esse subform passa por várias filtragens. Eu gostaria de pegar os registros (linhas) que restaram no subform após filtragem e salvar numa tabela.

A seleção das linhas pode ser de forma contínua.

Muito obrigado a todos!!

Veja aqui amigo:
https://www.maximoaccess.com/t28321-resolvidobotao-atualizar-so-atualiza-o-1-registro-vba
Percorre os registros do Formulario atraves do recordset.clone e realiza a mudança neles...

Boa tarde Fábio! Primeiramente, muito obrigado pela ajuda. O que eu quero fazer, na verdade, é salvar um conjunto de registros do meu subform numa tabela.
Se não for possível salvar todos ao mesmo tempo, pode ser um a um mesmo.

A foto abaixo é do subform já filtrado.


Montei uma tabela com todos os campos do subform, porém não consigo desenvolver o código.
estou tentando fazer dessa maneira, mas sem sucesso:

Código:


Private Sub PROD_DblClick(Cancel As Integer) 'duplo clique campo PROD
    
CurrentDb.Execute "INSERT INTO dados ( id, Empr,  PROD, TIPO, BITOLA, COMP, POS, COTA, MED, PR,  REF, DESC, PRDESC,  Data, QTDE, det ) VALUES('" & Me.ID & "','" & Me.EMPR & "', '" & Me.PROD & "','" & Me.TIPO & "','" & Me.BITOLA & "', '" & Me.COMP & "','" & Me.POS & "','" & Me.COTA & "','" & Me.MED & "','" & Me.PR & "','" & Me.REF & "', '" & Me.DESC & "','" & Me.PRDESC & "','" & Me.data & "' ,'" & Me.QTDE & "','" & Me.det & "')"
    
End Sub


achei esse código neste link, mas tbém não consegui. Fiz conforme descrito e não aconteceu nada.

https://answers.microsoft.com/pt-br/msoffice/forum/msoffice_access-mso_other/selecionar-dados-na-grid-e-exibir-no/ea9cdfcb-542a-4718-9258-9268f370c81f

Código:


Para quem precisa deste recurso para seleção de múltiplas linhas, a lógica é identificar qual a primeira linha selecionada, qual a quantidade de linhas selecionadas, abrir em memória uma cópia dos registros da tela e percorrê-los para trazer uma lista dos IDs selecionados. Esta lista de IDs pode ser usada como critério para abrir o formulário de edição.
 
1) O primeiro passo é você criar a seguinte função em um módulo: (esta função trará a lista dos IDs - chaves primárias - selecionados na folha de dados)
 
Public Function LinhasSelecionadas(frm As Form) As String
'Retorna a lista de IDs selecionados
Dim strIdField As String
Dim rst As DAO.Recordset
Dim lngLinhaIni As Long
Dim lngQtde As Long
Dim i As Long
Dim strLinhas
'Nome do campo chave (o campo deve ser numérico)
strIdField = "ID"
'Primeira linha selecionada
lngLinhaIni = frm.SelTop
'Qtde de linhas selecionadas
lngQtde = frm.SelHeight
If lngLinhaIni > 0 And lngQtde > 0 Then
    Set rst = frm.RecordsetClone
    'Percorre as linhas selecionadas, montando o string de critério
    For i = lngLinhaIni To lngLinhaIni + lngQtde - 1
        rst.MoveFirst
        rst.Move i - 1
        strLinhas = strLinhas & rst.Fields(strIdField) & ","
    Next i
    'Remove a última vírgula
    If strLinhas <> "" Then
        strLinhas = Left(strLinhas, Len(strLinhas) - 1)
    End If
End If
'Retorna a lista de linhas
LinhasSelecionadas = strLinhas
End Function
 
2) O segundo passo é chamar esta função para que o formulário de edição seja aberto apenas com os itens selecionados. O problema aqui é que ao clicar em um botão, a seleção é desfeita, então uma alternativa é fazer o acionamento pelo teclado (tecla F3, por exemplo), por meio do evento "Ao apertar tecla":
 
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
On Error GoTo ErrHandler
If KeyCode = vbKeyF3 And Shift = 0 Then
    Dim strListaID As String
    'Pega a lista dos IDs selecionados no subform
    strListaID = LinhasSelecionadas(Me)
    'Abre o form de edição (o nome do campo a ser filtrado é ID, mude para o nome do seu campo)
    DoCmd.OpenForm "Frm_Edicao", , , "ID IN(" & strListaID & ")"
End If
ExitHere:
Exit Sub
ErrHandler:
MsgBox Err.Description & vbCrLf & Err.Number & vbCrLf & Err.Source, vbCritical, "Form_KeyDown"
Resume ExitHere
Resume
End Sub


Amigo, leu o que te recomendei? Pois ele faz justamente isso!
Volte la e veja o tópico indicado!

Se atente para a função principal, que é de percorrer os registros que esta na tela, no formulário continuo... Veja que la eu apena atualizo um campo de uma tabela... Mas no seu caso basta substituir o Comando "Currentdb.execute... que tem la, pelo seu postado a cima!

Boa noite amigo Fábio! Cara, te agradeço imensamente por essa ajuda. Realmente foi muito importante para meu projeto. Criei um pequeno frankstein com seu código e o código desse link aqui https://www.maximoaccess.com/t10140-inserir-registro-via-vba-em-duas-tabelas.

Ficou da seguinte forma:

Código:


Public Function Cad() As Integer

Dim BancoDados As DAO.Database
Dim RStb As DAO.Recordset
Set BancoDados = CurrentDb()
    Set RStb = BancoDados.OpenRecordset("dados", dbOpenDynaset)
    RStb.AddNew
            RStb("empr") = Forms!prg!PRGSUB!EMPR
            RStb("prod") = Forms!prg!PRGSUB!PROD
            RStb("tipo") = Forms!prg!PRGSUB!TIPO
            RStb("bitola") = Forms!prg!PRGSUB!BITOLA
          
 RStb.Update
      
End Function


Aplicando no seu código:

Código:


Private Sub subc_Click()
Dim rs As Recordset
Set rs = Forms!prg!PRGSUB.Form.Recordset
rs.MoveFirst
Do While Not rs.EOF
With rs
Call Cad
rs.MoveNext
Forms!prg!PRGSUB.Form.Recalc
End With
Loop
Set rs = Nothing
dados.Close
End Sub


Ficou perfeito para a minha necessidade. Muito obrigado!! Valeu mesmo!!!

Abraço!

Que bom que deu certo!
Grato pelo retorno amigo, até a próxima se Deus Quiser!