You are here:--[RISOLTO] UF Ricerca Materiale – Bottone Elimina
[RISOLTO] UF Ricerca Materiale – Bottone Elimina 2017-12-18T19:55:55+00:00

Home Forum Domande su Excel VBA e MACRO [RISOLTO] UF Ricerca Materiale – Bottone Elimina

Tag: ,

  • Autore
    Articoli
  • REAPAT
    Partecipante
      Post totali: 29
      #844 |

      Ciao a tutto,
      Ciao Admin,

      ho trovato un altro mini errore che è simile alla modifica singola che mi hai sistemato. Ma non riesco a sistemarla. Ho provato a inserire parte del tuo codice anche per il bottone Elimina ma non funziona.

      Quando seleziono il materiale e premo bottone Elimina Materiale lo elimina correttamente. Quando però prima ricerco un materiale e dunque la listbox cambia. Devo andare a intercettare l’ID del materiale senno mi elimina un altro materiale.

      Ti allego il file e inserisco il codice dell’Elimina Materiale.
      Fammi sapere e grazie già in anticipo.

      Patrick

      Private Sub CommandButton20_Click()
      Dim Risp As Integer, Lrow As Long
      Dim r As Long, Ir As Long, i As Long
      Dim ComputerName
      
      Dim ora
      ora = Now
      Risp = MsgBox("Vuoi eliminare questo materiale ?", vbInformation + vbYesNo, "Controllo dati")
      Ir = 2
      
      If Risp = vbYes Then
      Lrow = Sheets("MaterialiEliminati").Range("A" & Rows.Count).End(xlUp).Row + 1
      Application.Calculation = xlCalculationManual
      For r = 0 To ListBox1.ListCount - 1
      If ListBox1.Selected(r) Then
      
      With Sheets("MaterialiEliminati")
      For i = 1 To 7
      .Cells(Lrow, i) = ListBox1.List(r, i - 1)
      Next i
      End With
      Range(Cells(Ir, 1), Cells(Ir, 8)).Delete
      Ir = Ir - 1
      
      Lrow = Lrow + 1
      End If
      Ir = Ir + 1
      Next
      Application.Calculation = xlCalculationAutomatic
      Else
      MsgBox "Nessun dato è stato rimosso!", vbExclamation, "Operazione Annulata!"
      Exit Sub
      End If
      
      MsgBox "Operazione effettuata con successo!", vbInformation, "Aggiornamento dati"
      
      Risp = Empty
      Lrow = Empty
      r = Empty
      Ir = Empty
      i = Empty
      ComputerName = Empty
      ora = Empty
      UserForm_Activate
      
      End Sub
      

      http://www.filedropper.com/ricercamaterialeiniziale_2

      • Questo argomento è stato modificato 11 mesi fa da BySalv BySalv.
      • Questo argomento è stato modificato 10 mesi fa da BySalv BySalv.
    • REAPAT
      Partecipante
        Post totali: 29

        Ho trovato un’altro piccolo bug, che comunque è sempre legato all’aggiornamento della listbox che bisogna andare a lavorare sull’ID materiale.

        Anche il bottone Conferma Modifica Multipla e il bottone come detto in precedenza ELIMINA.

        Allego il file giusto:
        http://www.filedropper.com/ricercamaterialeiniziale_3

        Grazie

      • BySalvBySalv
        Amministratore del forum
          Post totali: 285

          Ciao REAPAT, in complesso non ho capito bene cosa vuoi fare.

          1) Quando selezioni un prodotto è quello che vuoi eliminare?
          2) Solo quello oppure ci può essere un eliminazione multipla?
          3) Ho notato che esiste un foglio “MaterialiEliminati”, perchè.
          4) Il Prodotto/i deve essere eliminato dal foglio “Scheda_Prodotti”
          5) I Prodotti eliminati devono essere copiati prima nel foglio “MaterialiEliminati”, e devono conservare l’ID originale.

          Ciao By Sal :bye:

        • REAPAT
          Partecipante
            Post totali: 29

            Ciao vedo ora, scusa.

            Comunque si seleziono il materiale e lo voglio eliminare. Vorrei una seelzione multipla ma non riesco. Esiste il foglio MaterialiEliminati perchè vorrei che finissero li tutte le info presenti in scheda_prodotti del materiale selezionato per essere eliminato. Esatto bisogna conservare l’ID origiinale.

            Per ora dovrebbe funzionare il bottone elimina materiale solo per un materiale e non filtrando. Se filtri succede lo stesso problema della modifica singola del materiale filtrata. Lavora sulla riga e non ID.

            Fammi sapere,

            Ciao Patrick

          • BySalvBySalv
            Amministratore del forum
              Post totali: 285

              Ciao REAPAT eccoti la Macro Modificata, è segnato dove sono intervenuto.

              Private Sub CommandButton20_Click() 'elimina materiale
              Dim Risp As Integer, Lrow As Long
              Dim r As Long, Ir As Long, i As Long
              Dim ComputerName
              '--------------------------------------------------- righe aggiunte
              Dim rr, x, k, sh1 As Worksheet, sh2 As Worksheet
              
              Set sh1 = Worksheets("Scheda_Prodotti")
              Set sh2 = Worksheets("MaterialiEliminati")
              sh1.Activate
              '--------------------------------------------- Fine righe aggiunte
              
              Dim ora
              ora = Now
              Risp = MsgBox("Vuoi eliminare questo materiale ?", vbInformation + vbYesNo, "Controllo dati")
              Ir = 2
                  If Risp = vbYes Then
                      Lrow = Sheets("MaterialiEliminati").Range("A" & Rows.Count).End(xlUp).Row + 1
                      Application.Calculation = xlCalculationManual
                      For r = 0 To ListBox1.ListCount - 1
                           If ListBox1.Selected(r) = True Then
                              k = ListBox1.List(r, 6) '---------------------- riga aggiunta
                              Exit For
                           End If
                      Next r
                      Application.Calculation = xlCalculationAutomatic
                  Else
                      MsgBox "Nessun dato è stato rimosso!", vbExclamation, "Operazione Annulata!"
                      Exit Sub
                  End If
              '----------------------------------- righe aggiunte
              If sh2.Cells(2, 1) = "" Then rr = 2 Else rr = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
              For x = 2 To sh1.Cells(Rows.Count, 1).End(xlUp).Row
                  If sh1.Cells(x, 7) = k Then
                      Range(sh1.Cells(x, 1), sh1.Cells(x, 8)).Copy sh2.Cells(rr, 1)
                      Range(sh1.Cells(x, 1), sh1.Cells(x, 8)).Delete
                      Exit For
                  End If
              Next x
              '----------------------------------- fine righe aggiunte
              MsgBox "Operazione effettuata con successo!", vbInformation, "Aggiornamento dati"
              
               Risp = Empty
               Lrow = Empty
               r = Empty
               Ir = Empty
               i = Empty
               ComputerName = Empty
               ora = Empty
               UserForm_Activate
              End Sub 

              Ti allego anche il File

              http://www.filedropper.com/ricercamaterialeiniziale2

              Ogni prodotto eliminato viene riportato nel foglio “MaterialiEliminati”

              Ciao By Sal :bye:

            • REAPAT
              Partecipante
                Post totali: 29

                Ciao,

                ho controllato subito ciò che hai scritto e aperto il file.

                Il problema si pone ancora ma forse mi sono spiegato male io.

                Il problema è quando filtro i materiali, per es. inserisco televisori nel textbox “Tipologia”, avvio la ricerca e poi li seleziono un materiale, a quel punto tasto elimina ma non mi elimina nulla o peggio mi elimina un materiale nella posizione della listbox precedente. non lavora sull’ID.

                Fammi sapere,

                Patrick

              • BySalvBySalv
                Amministratore del forum
                  Post totali: 285

                  Ciao REAPAT, una mia svista in quanto il Codice ID ricavato, viene ricavato come Stringa, pertanto nella ricerca dell’ID non viene riconosciuto, questa la Modifica da fare nella Macro che ho scritto sopra.

                  '----------------------------------- righe aggiunte
                  If sh2.Cells(2, 1) = "" Then rr = 2 Else rr = sh2.Cells(Rows.Count, 1).End(xlUp).Row + 1
                  For x = 2 To sh1.Cells(Rows.Count, 1).End(xlUp).Row
                      If sh1.Cells(x, 7) = Val(k) Then '<--------------- Convertito k in valore Modificare
                          Range(sh1.Cells(x, 1), sh1.Cells(x, 8)).Copy sh2.Cells(rr, 1)
                          Range(sh1.Cells(x, 1), sh1.Cells(x, 8)).Delete
                          Exit For
                      End If
                  Next x
                  '----------------------------------- fine righe aggiunte

                  Ciao By Sal :bye:

                • REAPAT
                  Partecipante
                    Post totali: 29

                    Ho visto ora,

                    non so perchè non mi arrivano le notifiche su mail… Forse sono io che non ho attivato questa opzione.

                    Comunque il tasto Elimina ora con la piccola modifica inviata, va perfettamente.

                    Ora provo a far funzionare l’altro bottone (Conferma MODIFICHE).

                    Praticamente è l’altro problema, cioè solito problema che succedeva per conferma MODIFICA e tasto ELIMINA. Provo io a risolvere, al massimo ti chiedo :)

                    Ciao Magnifico Admin

                  • REAPAT
                    Partecipante
                      Post totali: 29

                      http://www.filedropper.com/ricercamaterialeiniziale_4

                      Questo è il file per provare il bottone Conferma ModifichE.

                      Non funziona quando effettuo una ricerca con un filtro. Non mi riesce a salvare le modifiche dopo aver ricercato un materiale.

                    La discussione ‘[RISOLTO] UF Ricerca Materiale – Bottone Elimina’ è chiusa a nuove risposte.

                    Utilizzando il sito, accetti l'utilizzo dei cookie da parte nostra. maggiori informazioni

                    Questo sito utilizza i cookie per fornire la migliore esperienza di navigazione possibile. Continuando a utilizzare questo sito senza modificare le impostazioni dei cookie o cliccando su "Accetta" permetti il loro utilizzo.

                    Chiudi