You are here:Home-Domande su Excel VBA e MACRO-[RISOLTO] ListBox MultiSelect elimina righe-Rispondi a: [RISOLTO] ListBox MultiSelect elimina righe
Rispondi a: [RISOLTO] ListBox MultiSelect elimina righe2018-01-23T17:21:12+01:00

Home Forum Domande su Excel VBA e MACRO [RISOLTO] ListBox MultiSelect elimina righe Rispondi a: [RISOLTO] ListBox MultiSelect elimina righe

sidsid
Moderatore
    Post totali: 752

    Ciao
    Un approccio diverso dall’eliminazione delle righe nel foglio.
    – In pratica le righe non selezionate della listbox le carico in un array; quindi l’array contiene solo le righe che non devo cancellare.
    – poi Elimino il database esistente e lo popolo con l’array contenente gli item da tenere
    – faccio tutto con il pulsante “Elimina” della form.
    Un accorgimento: a fine macro dovrò ripopolare la listbox con gli item che ho deciso di lasciare; quindi devi richiamare la sub mCaricaTuttiDati abbinata all’evento click del pulsante Modifica.
    Per poter eseguire quell’evento, devo trasformarlo in evento Pubblico.
    Semplicemente l’intestazione dell’evento diventa
    Public Sub mCaricaTuttiDati_click() invece che Private Sub mCaricaTuttiDati_click()

    Altro accorgimento nella sub mCaricaTuttiDati_click :
    Se il database è vuoto , la variabile lRiga restituirà valore 3 perchè il database parte da riga4,
    Quindi prima di popolare la listbox, verifico che lRiga sia > di 3

    .............
    With SH
    lRiga = .Range("A" & .Rows.Count).End(xlUp).Row
    aTabella = .Range("A4:d" & lRiga)
    End With
    
    If lRiga > 3 Then
    ''''''''''''''''''

    Infine la macro rivista abbinata all’evento click del pulsante CmsCancella

    Private Sub CmsCancella_Click()
    Dim Selezionati() As Integer
    Dim Ind As Integer
    Dim vNewTab() As Variant
    Dim nRiga As Long, j As Long, nIncr As Long
    Dim check As VbMsgBoxResult
    
    Ind = -1
    For a = 0 To ListBox1.ListCount - 1
    If ListBox1.Selected(a) Then
    Ind = Ind + 1
    ReDim Preserve Selezionati(Ind)
    Selezionati(Ind) = a
    End If
    Next a
    
    If Ind = -1 Then
    MsgBox "Nessun Elemento selezionato"
    Exit Sub
    Else
    MsgBox "Selezionati " & Ind + 1 & " Elementi"
    End If
    
    check = MsgBox("QUESTO COMANDO CANCELLA IL CLIENTE SELEZIONATO. SI INTENDE CONTINUARE ?", vbYesNo)
    If check = vbYes Then
    MsgBox "Sto eseguendo la macro"
    With Sheets("AnagClienti")
    For j = 0 To Me.ListBox1.ListCount - 1
    If ListBox1.Selected(j) = False Then
    nIncr = nIncr + 1
    ReDim Preserve vNewTab(1 To 33, 1 To nIncr)
    For nRiga = 1 To 33
    vNewTab(nRiga, nIncr) = .Cells(j + 4, nRiga)
    Next nRiga
    End If
    Next j
    If nIncr = 1 Then
    ReDim Preserve vNewTab(1 To 33, 1 To nIncr + 1)
    End If
    .Range("A4:AG" & Rows.Count).ClearContents
    If nIncr > 0 Then
    .Range("A4:AG" & nIncr + 3).Value = Application.WorksheetFunction.Transpose(vNewTab)
    End If
    Me.ListBox1.Clear
    Call Me.mCaricaTuttiDati_click
    End With
    End If
    
    End Sub

    Ti consiglio vivamente di eseguire i test su un file di backup; le modifiche le ho testate, ma l’errore è dietro l’angolo :bye: