Excluir um ou mais registros selecionados em Formulário Contínuo

Boa noite!

Bd em Access 2010.

Estou atualizando o formulário contínuo ListaVendasNFe de modo que seja possível excluir o(s) registro(s) quando marcado a opção Det (Detalhar) de modo que:

1-Possa ser excluído apenas um registro selecionado. (está funcionando)

2-Possam ser excluídos registros marcados aleatoriamente.

3-Possam ser excluídos registros marcados através do botão "Marcar Todos", porém respeitando o filtro das datas inicial e final. (Observei que o formulário filtra os registros do período selecionado, porém clicando no botão "Marcar Todos", todos os demais registros da tabela também ficam marcados.

Gostaria de ajuda para solucionar esse caso.

Desde já agradeço.

Segue anexo.

Bom dia,

Supondo que voce tenha um campo "marcado" (tipo sim/não) na tabela, você pode usar a estrutura de repetição Do While em conjunto com a propriedade EOF do recordset. Ficaria algo assim:

Código:

Dim db as database
Dim rs as Recordset

Set db = CurrentDb
Set rs = db.OpenRecorset("SELECT marcado FROM [tabela] where marcado = true")

If rs.RecordCount > 0 then
    Do While Not rs.EOF
        db.Execute "DELETE * FROM [tabela] WHERE marcado = true"
        
        rs.MoveNext
    Loop
End if

Uma rápida explicação do código:

- Primeiro é definido o recordset com os critérios necessários (marcado = true).
- Depois contamos se há algum registro no recordset (rs.RecordCount > 0). Isso é necessário pois, caso não haja nenhum registro que atenda aos critérios, ou seja, não tenha nenhum registro marcado, o Access retorna erro em tempo de execução por não haver registros dentro do recordset e o aplicativo é parado (se tiver no Access runtime ele é fechado automaticamente), isto porque você tenterá ir para o proximo registro (rs.MoveNext) sendo que este não existe. Impensável não é mesmo? Então é preciso verificar através dessa propriedade que retorna a quantidade de registros no recordset. Caso não tenha nenhum, ele pula a rotina.
- Depois a estrutura de repetição que basicamente diz "faça enquanto não chegar no ultimo registro". A propriedade EOF (End Of File) do recordset determina qual é o ultima registro da série, ou seja, o laço será automaticamente desfeito quando o registro selecionado for este.

Ps.: jamais, em hipótese alguma, com nenhum pensamento, por nenhuma causa, esqueça do rs.MoveNext. Sem isso o programa estrará em loop infinito.

Caso não seja esse o criterio que ta utilizando, basta altera-lo no Set do rescordset e no Execute do db.

Abraço.

CassioFabre, obrigado pela resposta e principalmente pela explicação.

No Bd teste que postei aqui no forum apliquei sua instrução e funcionou em parte, pois quando é feita a seleção através do botão Marcar todos, não é respeitado o período das datas selecionadas, mancando assim todos os registros da tabela.

No mais eu gostaria de adaptar essa instrução que você passou no código abaixo, que é o código que consta atualmente no botão Excluir do Formulário do Bd Oficial. Porém não consegui nenhum sucesso... Segue código:

Código:

Private Sub BotaoExcluir_Click()
   If Not IsNull(Me.NUMEROPEDIDO) Then
   
       'If Me.Status = "Cupom Fiscal" Then
       '    Beep
       '    MsgBox "Este pedido não pode ser excluído." & PulaLinha(1) & "Foi gerado um cupom fiscal através dele.", vbCritical, "Atenção!"
       '    Exit Sub
       'End If
       
       Ambiente = IIf(DLookup("[IdentificacaoAmbiente]", "NFe_Parametros") = 2, "Homologação", "Produção")
       
       If Ambiente = "PRODUÇÃO" Then
           If Me.Status = "NFe autorizada" Or Me.Status = "NFe cancelada" Then
               Beep
               MsgBox "Este pedido não pode ser excluído." & PulaLinha(1) & "Foi gerado uma Nota Fiscal Eletrônica através dele.", vbCritical, "Atenção!"
               Exit Sub
           End If
           
           If Me.Status = "Em processamento" Then
               Beep
               MsgBox "Este pedido não pode ser excluído." & PulaLinha(1) & "Foi gerado uma Nota Fiscal Eletrônica através dele.", vbCritical, "Atenção!"
               Exit Sub
           End If
       End If
       
       If PodeExcluir Then
           GeraLog = Log("Venda de mercadorias " & Me.ccNomCli, "E", Val(Me.NUMEROPEDIDO))
           
           'Verifica se pela natureza da operação será baixado o estoque
           
           If Nz(DLookup("ESTOQUE", "TBL_CFOP", "CFOP = " & "'" & Me.CFOP & "'"), "") = "Baixar" Then
               Set dbs = CurrentDb
               strSQL = "SELECT * FROM tbl_VendasItens WHERE NUMEROPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
               Set rst = dbs.OpenRecordset(strSQL)
                   
               Do While Not rst.EOF
                   xCodigo = rst("CODIGO")
                   xQuantidade = rst("QUANTIDADE")
                   Me.Repaint
                                 
                   Set dbs = CurrentDb
                   strSQL = "SELECT * FROM tbl_Produtos WHERE ccVarPro = " & "'" & xCodigo & "'"
                   Set rstPro = dbs.OpenRecordset(strSQL)
                   
                   If rstPro.RecordCount > 0 Then
                       xEstoque = rstPro("ccEstoque")
                       xEstoqueAtual = xEstoque + xQuantidade
                               
                       strSQL = "UPDATE tbl_Produtos set ccEstoque = '" & IIf(IsNull(xEstoqueAtual), 0, xEstoqueAtual) & "'"
                       strSQL = strSQL & " WHERE ccVarPro = " & "'" & xCodigo & "'"
                       On Error GoTo erro
                       Workspaces(0).Databases(0).Execute strSQL
                   End If
                   rstPro.Close
                   rst.MoveNext
               Loop
           End If
           
           strSQL = "DELETE * FROM NFe_InfProdutos WHERE NPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
           On Error GoTo erro
           Workspaces(0).Databases(0).Execute strSQL
           
           strSQL = "DELETE * FROM NFe_InfNotaFiscal WHERE NPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
           On Error GoTo erro
           Workspaces(0).Databases(0).Execute strSQL
           
           strSQL = "DELETE * FROM START_NFE WHERE NPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
           On Error GoTo erro
           Workspaces(0).Databases(0).Execute strSQL
           
           strSQL = "DELETE * FROM START_NFEITENS WHERE NPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
           On Error GoTo erro
           Workspaces(0).Databases(0).Execute strSQL
           
           strSQL = "DELETE * FROM tbl_Recebimentos WHERE NUMEROPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
           On Error GoTo erro
           Workspaces(0).Databases(0).Execute strSQL
           
           strSQL = "DELETE * FROM tbl_FluxoCaixa WHERE NUMEROPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
           On Error GoTo erro
           Workspaces(0).Databases(0).Execute strSQL
           
           strSQL = "DELETE * FROM tbl_ContasAReceber WHERE NUMEROPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
           On Error GoTo erro
           Workspaces(0).Databases(0).Execute strSQL
           
           strSQL = "DELETE * FROM tbl_VendasPagamentos WHERE NUMEROPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
           On Error GoTo erro
           Workspaces(0).Databases(0).Execute strSQL
           
           strSQL = "DELETE * FROM tbl_VendasItens WHERE NUMEROPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
           On Error GoTo erro
           Workspaces(0).Databases(0).Execute strSQL
       
           strSQL = "DELETE * FROM tbl_Vendas WHERE NUMEROPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
           On Error GoTo erro
           Workspaces(0).Databases(0).Execute strSQL
           
           MsgBox "Nota fiscal excluída com êxito!", vbInformation, "Exclusão"
               
           Me.Requery
           
       End If
           
VoltaErro:
     
   Else
       Beep
       MsgBox "Nenhum pedido foi selecionado !", vbExclamation, "Exclusão"
   End If
   Exit Sub

erro:
   Beep
   MsgBox Error$, vbCritical, "Edição"
   Resume VoltaErro
End Sub

Outro problema que o Bd oficial apresenta é que o campo Detalhar só é marcado ou desmarcado através dos botões (marcar ou desmarcar todos)... Quando clico no campo Detalhar ele não é marcado e mostra a mensagem "Este recordset não pode ser atualizado".

Olá..

Meu access é 2007 não tenho acesso ao seu BD, mas analisando os post conclui que voce tem um botão Selecionar todos, desmarcar todos e Excluir e que o campo opção seja Detalhar
Então faça os testes e veja se da certo:

No Botão selecionar todos Adapte este código

Código:

Do While Not Me.Form.RecordsetClone.EOF
        Me.Form.RecordsetClone.Edit
        Me.Form.RecordsetClone!Detalhar = True
        Me.Form.RecordsetClone.Update
        Me.Form.RecordsetClone.MoveNext
        Loop
        Exit Sub

No Botão desmarcar todos adapte este

Código:

 Do While Not Me.Form.RecordsetClone.EOF
        Me.Form.RecordsetClone.Edit
        Me.Form.RecordsetClone!Detalhar = False
        Me.Form.RecordsetClone.Update
        Me.Form.RecordsetClone.MoveNext
        Loop
        Exit Sub

E no botão excluir Adapte este

Código:

 Dim rs As Recordset
       
  Set rs = Me.Form.Recordset
 
  rs.MoveFirst
  Do While Not rs.EOF
        With rs
        .Edit
            If Me.Detalhar = True Then
           
                Me.Recordset.Delete
        .Update
            End If
        .MoveNext
        End With
        Loop
        rs.Close
  Set rs = Nothing
        'Me.Form.Refresh
        Me.Requery

Aguardo retorno

Abraços

Celso,

infelizmente sua sugestão não funcionou.

Apareceu o erro: 3020 Update ou CancelUpdate sem AddNew ou Edit.

O que preciso é de uma maneira para selecionar os registros que precisam ser excluídos (com ou sem uma caixa de seleção) .

Por exemplo: Clicar e arrastar para baixo marcando os registros (no formulário contínuo) ou pressionar o Ctrl e clicar nos registros de forma aleatória deixando-os marcados para exclusão...



Abraço

Olá..
Este erro é que não encontrou registros para editar então estou aplicando um On error para ele ignorar o erro, Não é recomendado.
Então faça os testes, se Ok tente buscar um jeito de tratar o erro.
ele tem que entender que existe registros para editar,hoje eu não tive tempo de procurar uma maneira de corrigir.
Mas ignorando o erro ele faz exatamente oque precisa e tambem voce pode marcar e desmarcar de forma aleatória.

No botão Marcar altere para este

Código:

On Error Resume Next
        Do While Not Me.Form.Recordset.EOF
        Me.Form.Recordset.Edit
        Me.Form.Recordset!Detalhar = True
        Me.Form.Recordset.Update
        Me.Form.Recordset.MoveNext
        Loop
        'Exit Sub
        Me.Requery

No Botão Desmarcar altere para este

Código:

On Error Resume Next
        Do While Not Me.Form.Recordset.EOF
        Me.Form.Recordset.Edit
        Me.Form.Recordset!Detalhar = False
        Me.Form.Recordset.Update
        Me.Form.Recordset.MoveNext
        Loop
        'Exit Sub
        Me.Requery

Aguardo retorno

Abraços

olá...

Segue o código corrigido sem o erro

No botão marcar todos

Código:

 Me.Form.Recordset.MoveFirst
        Do While Not Me.Form.Recordset.EOF
        Me.Form.Recordset.Edit
        Me.Form.Recordset!Detalhar = True
        Me.Form.Recordset.Update
        Me.Form.Recordset.MoveNext
        Loop
        'Exit Sub
        Me.Requery

No botão desmarcar todos

Código:

Me.Form.Recordset.MoveFirst
        Do While Not Me.Form.Recordset.EOF
        Me.Form.Recordset.Edit
        Me.Form.Recordset!Detalhar = False
        Me.Form.Recordset.Update
        Me.Form.Recordset.MoveNext
        Loop
        'Exit Sub
        Me.Requery

Aguardo retorno

Abraços

Celso, mais uma vez, obrigado pela atenção, mas permanece o erro ao clicar no botão excluir: 3020 Update ou CancelUpdate sem AddNew ou Edit.
Segue anexo do Bd.

Boa Tarde, se me permitem um simples pitaco

Em um formulário continuo que tem o campo Sim/não

Private Sub bt_excluir_Click()

If MsgBox("Tem certeza que deseja excluir os artigos selecionados ?", vbYesNo + vbQuestion, Me.Caption) = vbNo Then
MsgBox "Ação cancelada pelo usuário", vbInformation, Me.Caption
Exit Sub

Else

Dim SQL As String
       DoCmd.SetWarnings False 'Aviso de execução
       SQL = "DELETE * FROM SuaTAbela WHERE SeucampoSim/Nao= forms!SEuFrmContinuo!SeucampoSim/Nao =  -1" 'ALTERE O NOME DA TABELA E NOME DO CAMPO
                             'tabela       nome do campo
       DoCmd.RunSQL SQL 'Executa consulta
                                   
       MsgBox "Exclusão de registro(s) realizada com sucesso!", vbInformation, Me.Caption   'Confirmação do processo
       Me.Form.Requery
     
End If
End Sub

Olá...

A todos um feliz 2017

Me desculpe, como não tinha seu BD eu achei que o erro estava no selecionar e desmarcar, mas o erro estava na exclusão.
O exemplo do Grande Sílvio corrige este problema

Segue o exemplo do Silvio

Código:

If MsgBox("Tem certeza que deseja excluir os artigos selecionados ?", vbYesNo + vbQuestion, Me.Caption) = vbNo Then
MsgBox "Ação cancelada pelo usuário", vbInformation, Me.Caption
Exit Sub

Else

Dim SQL As String
      DoCmd.SetWarnings False 'Aviso de execução
      SQL = "DELETE * FROM tbl_Vendas WHERE Detalhar= forms!ListaVendasNFe!Detalhar =  -1" 'ALTERE O NOME DA TABELA E NOME DO CAMPO
                            'tabela      nome do campo
      DoCmd.RunSQL SQL 'Executa consulta
                                 
      MsgBox "Exclusão de registro(s) realizada com sucesso!", vbInformation, Me.Caption  'Confirmação do processo
      Me.Form.Requery
     
End If

Valeu meu amigo pelo Pitaco

Abraços e

Aguardamos retorno

Celso, obrigado! Funcionou!

Só uma dúvida:

No modelo antigo desse formulário, quando não havia a Caixa de Seleção para selecionar o registro, bastava clicar na linha do registro que deveria ser excluído e clicar no botão excluir... assim eram excluídos todos dos lançamentos "desse registro" contidos em outras tabelas. Assim:

Código:

strSQL = "DELETE * FROM NFe_InfProdutos WHERE NPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
          On Error GoTo erro
          Workspaces(0).Databases(0).Execute strSQL
         
          strSQL = "DELETE * FROM NFe_InfNotaFiscal WHERE NPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
          On Error GoTo erro
          Workspaces(0).Databases(0).Execute strSQL
         
          strSQL = "DELETE * FROM START_NFE WHERE NPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
          On Error GoTo erro
          Workspaces(0).Databases(0).Execute strSQL
         
          strSQL = "DELETE * FROM START_NFEITENS WHERE NPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
          On Error GoTo erro
          Workspaces(0).Databases(0).Execute strSQL
         
          strSQL = "DELETE * FROM tbl_Recebimentos WHERE NUMEROPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
          On Error GoTo erro
          Workspaces(0).Databases(0).Execute strSQL
         
          strSQL = "DELETE * FROM tbl_FluxoCaixa WHERE NUMEROPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
          On Error GoTo erro
          Workspaces(0).Databases(0).Execute strSQL
         
          strSQL = "DELETE * FROM tbl_ContasAReceber WHERE NUMEROPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
          On Error GoTo erro
          Workspaces(0).Databases(0).Execute strSQL
         
          strSQL = "DELETE * FROM tbl_VendasPagamentos WHERE NUMEROPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
          On Error GoTo erro
          Workspaces(0).Databases(0).Execute strSQL
         
          strSQL = "DELETE * FROM tbl_VendasItens WHERE NUMEROPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
          On Error GoTo erro
          Workspaces(0).Databases(0).Execute strSQL
     
          strSQL = "DELETE * FROM tbl_Vendas WHERE NUMEROPEDIDO = " & "'" & Me.NUMEROPEDIDO & "'"
          On Error GoTo erro
          Workspaces(0).Databases(0).Execute strSQL


Com esse novo modelo de seleção, o que devo fazer para que essas exclusões continuem?

Olá..

Não seria mais fácil excluir pelo relacionamentos das tabelas marcando a opção "Propagar exclusão dos registros Relacionados"?
Caso não, anexe seu BD Atualizado com as novas tabelas envolvidas

PS: Minha versão do access é 2007

Aguardo

Abarços

Olá....

Conseguiu Resolver?

Aguardamos
Abraços

Celso,

ainda não consegui resolver... como era um caso de urgência, acabei excluindo os registros um a um...

mas pretendo fazer esse método de exclusão coletiva funcionar...

assim que tiver algo, estarei informando aqui...

por enquanto, mais uma vez, muito obrigado pela atenção!

Abraço

Chamon bom dia,

Segue seu sistema com as devidas solicitações.
Mantive o form original e criei um novo e trabalhei em cima dele.

Espero ter ajudado.

Qualquer problema nos informe.

Abraço.

E ai Chamon,

Deu certo?

Boa noite Alexandre!



Vou fazer alguns testes e tentar adaptar ao sistema...

Assim que tiver os resultados, postarei o feedback.

No mais, muito obrigado!

Abraço