Previous page | 1 | Next page
Facebook  

Cancellare cella da listview

Last Update: 3/18/2020 3:40 PM
Author
Print | Email Notification    
Post: 1
Registered in: 3/16/2020
Age: 25
Junior User
ultima
OFFLINE
3/16/2020 7:49 PM
 
Modify
 
Delete
 
Quote

Ciao,
qualcuno saprebbe aiutarmi a correggere queste stringe di codice del VBA di excell per cancellare celle del foglio di lavoro cancellando la riga del listview , ad aggiungere e modificare già risolto.

Il codice e questo allegato
cancella cella
Sub cancella_scavi()
Dim domanda_cancella
On Error GoTo ErrorHandler
    With UserForm1
    domanda_cancella = MsgBox("Desideri cancellare questo scavo?", vbYesNo, "Attenzione!!!")
    
        If domanda_cancella = vbYes Then
            
            .ListView1.ListItems.Remove (.ListView1.SelectedItem.Index)
        End If
        
    End With
            
ErrorHandler:
Exit Sub
End Sub
Post: 2,582
Registered in: 4/6/2013
Location: ROMA
Age: 73
Veteran User
2010
OFFLINE
3/17/2020 10:12 AM
 
Modify
 
Delete
 
Quote

e che c'è nelle colonne della list view affinchè si possa risalire alle celle da cancellare ?

saluti



[Edited by dodo47 3/17/2020 10:53 AM]
Domenico
Win 10 - Excel 2016
Post: 1
Registered in: 3/16/2020
Age: 25
Junior User
ultima
OFFLINE
3/17/2020 12:26 PM
 
Modify
 
Delete
 
Quote

Altre informazioni
Buongiorno, ringrazio per la risposta ricevuta da
dodo47 e ringrazio già in anticipo chi riuscirà ad aiutarmi,
allego varie parti del codice anche con le parti che funzionano per aiutare altre persone che trovano difficoltà con listview in vba di excell.
Con questo codice
popolo la listview premendo sul pulsante inserisci ( commandbutton18 ) e prendendo i dati da 3 textbox ( textbox22, textbox193 e textbox194 ) e vari optionbutton a seconda del if e fare aggiornare il foglio di lavoro di excel attivando il CommandButton21
FUNZIONA

Correggo gli errori di inserimento che un eventuale utente può compiere nell'inserimento dei dati nella listview selezionando la riga della listview e premendo sul pulsante correggi ( commandbutton19 ) facendo avviare il codice per correggere la riga della listview e inoltre facendo attivare anche il pulsante CommandButton21 che aggiorna il foglio di lavoro
FUNZIONA

Il problema, se si può chiamare così lo ho premendo il pulsante Cancella ( CommandButton20 ) che mi cancella la riga della listview ma non mi aggiorna il foglio di lavoro come fanno gli altri comandi, bensì rimangono riempite le celle con i vecchi dati e non si aggiornano.
PROBLEMA

Spero di essere stato abbastanza chiaro nel fornire informazioni richieste.



Configurazione della listview ad inizializzazione dell'useform

Sub configurazione_listview()
    With UserForm1.ListView1
        .Gridlines = True
        .View = lvwReport
        .FullRowSelect = True
        .MultiSelect = True
        .ColumnHeaders.Add Text:="Tratto", Width:=42
        .ColumnHeaders.Add Text:="Sede", Width:=130, Alignment:=lvwColumnCenter
        .ColumnHeaders.Add Text:="Pavimentazione", Width:=100, Alignment:=lvwColumnCenter
        .ColumnHeaders.Add Text:="Lunghezza", Width:=85, Alignment:=lvwColumnCenter
        .ColumnHeaders.Add Text:="Larghezza", Width:=85, Alignment:=lvwColumnCenter
        .ColumnHeaders.Add Text:="Altezza", Width:=60, Alignment:=lvwColumnCenter
        .Left = 216
        .Top = 396
    
    End With

End Sub


 Pulsante che attiva il codice riempimento listview
Private Sub CommandButton18_Click()
modulolistview.addizionare_scavi
modulolistview.conta_scavi
CommandButton21.Value = True
End Sub


Pulsante che attiva il codice aggiorna foglio di lavoro con righe da listview
Private Sub CommandButton21_Click()
Sheets("APERTURA_RELAZ TECNICA").Activate
modulolistview.inserisci_in_tabella
End Sub


Codice che aggiorna le celle del foglio di lavoro con le righe della listview

Sub inserisci_in_tabella()

With UserForm1.ListView1
On Error GoTo Er3
.ListItems(1).Selected = True
Cells(48, 2) = .SelectedItem
Cells(48, 7) = .SelectedItem.SubItems(1)
Cells(48, 16) = .SelectedItem.SubItems(2)
Cells(48, 28) = .SelectedItem.SubItems(3)
Cells(48, 36) = .SelectedItem.SubItems(4)
Cells(48, 44) = .SelectedItem.SubItems(5)
.ListItems(2).Selected = True
On Error GoTo Er4
Cells(49, 2) = .SelectedItem
Cells(49, 7) = .SelectedItem.SubItems(1)
Cells(49, 16) = .SelectedItem.SubItems(2)
Cells(49, 28) = .SelectedItem.SubItems(3)
Cells(49, 36) = .SelectedItem.SubItems(4)
Cells(49, 44) = .SelectedItem.SubItems(5)
.ListItems(3).Selected = True
On Error GoTo Er5
Cells(50, 2) = .SelectedItem
Cells(50, 7) = .SelectedItem.SubItems(1)
Cells(50, 16) = .SelectedItem.SubItems(2)
Cells(50, 28) = .SelectedItem.SubItems(3)
Cells(50, 36) = .SelectedItem.SubItems(4)
Cells(50, 44) = .SelectedItem.SubItems(5)
.ListItems(4).Selected = True
On Error GoTo Er6
Cells(51, 2) = .SelectedItem
Cells(51, 7) = .SelectedItem.SubItems(1)
Cells(51, 16) = .SelectedItem.SubItems(2)
Cells(51, 28) = .SelectedItem.SubItems(3)
Cells(51, 36) = .SelectedItem.SubItems(4)
Cells(51, 44) = .SelectedItem.SubItems(5)
.ListItems(5).Selected = True
On Error GoTo Er7
Cells(52, 2) = .SelectedItem
Cells(52, 7) = .SelectedItem.SubItems(1)
Cells(52, 16) = .SelectedItem.SubItems(2)
Cells(52, 28) = .SelectedItem.SubItems(3)
Cells(52, 36) = .SelectedItem.SubItems(4)
Cells(52, 44) = .SelectedItem.SubItems(5)
.ListItems(6).Selected = True
On Error GoTo Er8
Cells(53, 2) = .SelectedItem
Cells(53, 7) = .SelectedItem.SubItems(1)
Cells(53, 16) = .SelectedItem.SubItems(2)
Cells(53, 28) = .SelectedItem.SubItems(3)
Cells(53, 36) = .SelectedItem.SubItems(4)
Cells(53, 44) = .SelectedItem.SubItems(5)
.ListItems(7).Selected = True
On Error GoTo Er9
Cells(54, 2) = .SelectedItem
Cells(54, 7) = .SelectedItem.SubItems(1)
Cells(54, 16) = .SelectedItem.SubItems(2)
Cells(54, 28) = .SelectedItem.SubItems(3)
Cells(54, 36) = .SelectedItem.SubItems(4)
Cells(54, 44) = .SelectedItem.SubItems(5)
.ListItems(8).Selected = True
On Error GoTo Er10
Cells(55, 2) = .SelectedItem
Cells(55, 7) = .SelectedItem.SubItems(1)
Cells(55, 16) = .SelectedItem.SubItems(2)
Cells(55, 28) = .SelectedItem.SubItems(3)
Cells(55, 36) = .SelectedItem.SubItems(4)
Cells(55, 44) = .SelectedItem.SubItems(5)


Er3:
Er4:
Er5:
Er6:
Er7:
Er8:
Er9:
Er10:
End With

End Sub


Codice riempimento listview

Sub addizionare_scavi()

    Dim lista
    With UserForm1
        If .Label87.Caption > "8" Then
            MsgBox ("numero di interventi superiori alla capacità della tabella")
            Exit Sub
        End If
        Set lista = .ListView1.ListItems.Add(Text:=" \ ")
        lista.SubItems(3) = .TextBox193.Value
        lista.SubItems(4) = .TextBox194.Value
        lista.SubItems(5) = .TextBox22.Value
        If .OptionButton22.Value = True Then
            lista.SubItems(1) = .OptionButton22.Caption
        ElseIf .OptionButton24.Value = True Then
            lista.SubItems(1) = .OptionButton24.Caption
        ElseIf .OptionButton23.Value = True Then
            lista.SubItems(1) = .OptionButton23.Caption
        End If
        
        If .OptionButton18.Value = True Then
            lista.SubItems(2) = .OptionButton18.Caption
        ElseIf .OptionButton19.Value = True Then
            lista.SubItems(2) = .OptionButton19.Caption
        ElseIf .OptionButton20.Value = True Then
            lista.SubItems(2) = .OptionButton20.Caption
        ElseIf .OptionButton21.Value = True Then
            lista.SubItems(2) = .OptionButton21.Caption
        ElseIf .OptionButton25.Value = True Then
            lista.SubItems(2) = .OptionButton25.Caption
        ElseIf .OptionButton26.Value = True Then
            lista.SubItems(2) = .OptionButton26.Caption
        End If

    End With
End Sub



pulsante che attiva codice correggi riga listview e corregge la cella del foglio di lavoro

Private Sub CommandButton19_Click()
modulolistview.correggere_scavi
modulolistview.conta_scavi
CommandButton21.Value = True


codice che corregge la riga listview e la cella del foglio di lavoro
Sub correggere_scavi()
On Error GoTo ErrorHandler1
    With UserForm1
        .ListView1.SelectedItem.SubItems(3) = .TextBox193.Value
        .ListView1.SelectedItem.SubItems(4) = .TextBox194.Value
        .ListView1.SelectedItem.SubItems(5) = .TextBox22.Value
        If .OptionButton22.Value = True Then
            .ListView1.SelectedItem.SubItems(1) = .OptionButton22.Caption
        ElseIf .OptionButton24.Value = True Then
            .ListView1.SelectedItem.SubItems(1) = .OptionButton24.Caption
        ElseIf .OptionButton23.Value = True Then
            .ListView1.SelectedItem.SubItems(1) = .OptionButton23.Caption
ErrorHandler1:
Exit Sub
        End If
On Error GoTo ErrorHandler2
         If .OptionButton18.Value = True Then
            .ListView1.SelectedItem.SubItems(2) = .OptionButton18.Caption
        ElseIf .OptionButton19.Value = True Then
            .ListView1.SelectedItem.SubItems(2) = .OptionButton19.Caption
        ElseIf .OptionButton20.Value = True Then
            .ListView1.SelectedItem.SubItems(2) = .OptionButton20.Caption
        ElseIf .OptionButton21.Value = True Then
            .ListView1.SelectedItem.SubItems(2) = .OptionButton21.Caption
        ElseIf .OptionButton25.Value = True Then
            .ListView1.SelectedItem.SubItems(2) = .OptionButton25.Caption
        ElseIf .OptionButton26.Value = True Then
            .ListView1.SelectedItem.SubItems(2) = .OptionButton26.Caption
ErrorHandler2:
Exit Sub
        End If


    End With
End Sub


Pulsante che attiva il codice cancella cella della listview

Private Sub CommandButton20_Click()
modulolistview.cancella_scavi
modulolistview.conta_scavi
If CommandButton20.Value = True Then
    CommandButton21.Value = True
End If
End Sub


codice della sub cancella scavi, che dovrebbe cancellare riga della listview e cancellare cella dal foglio di lavoro,ma cancella solamente la riga della listview

Sub cancella_scavi()
Dim domanda_cancella
On Error GoTo ErrorHandler
    With UserForm1
    domanda_cancella = MsgBox("Desideri cancellare questo scavo?", vbYesNo, "Attenzione!!!")
    
        If domanda_cancella = vbYes Then
            
            .ListView1.ListItems.Remove (.ListView1.SelectedItem.Index)
        End If
        
    End With
            
ErrorHandler:
Exit Sub
End Sub


[Edited by by sal 3/18/2020 4:06 PM]
Post: 4,349
Registered in: 6/21/2013
Location: NAPOLI
Age: 67
Master User
Excel 2013
OFFLINE
3/17/2020 12:28 PM
 
Modify
 
Delete
 
Quote

Secondo me se non alleghi il file, pur con tutta quella marea di codice, si può dire poco o nulla.

Senza un file il codice dove lo si prova?

Alfredo
Post: 2
Registered in: 3/16/2020
Age: 25
Junior User
ultima
OFFLINE
3/17/2020 12:33 PM
 
Modify
 
Delete
 
Quote

file allegato
Come da oggetto della risposta ecco il file allegatovi, le righe di codice ne sono un sacco, perdonatemi per il macello.

Post: 2,584
Registered in: 4/6/2013
Location: ROMA
Age: 73
Veteran User
2010
OFFLINE
3/18/2020 11:11 AM
 
Modify
 
Delete
 
Quote

ciao (e sempre che ci abbia capito qualcosa)

non ti cancella perchè non ci sono le istruzioni per cancellare.

La seguente modifica funzionerebbe MA devi cancellare 1 sola riga oppure in ordine la 1a, poi la 2a etc, questo in quanto il giochino di trovare la riga da cancellare aggiungendo 47 alla listRow funziona solo in questo caso.

Sub cancella_scavi()
Dim domanda_cancella
On Error GoTo ErrorHandler
    With UserForm1
    domanda_cancella = MsgBox("Desideri cancellare questo scavo?", vbYesNo, "Attenzione!!!")
    
        If domanda_cancella = vbYes Then
            riga = UserForm1.ListView1.SelectedItem.Index + 47
            Rows(riga).ClearContents
            .ListView1.ListItems.Remove (.ListView1.SelectedItem.Index)
        End If
        
    End With
            
ErrorHandler:
Exit Sub
End Sub


Vedi se trovi tu un sistema migliore del tipo:
al posto di mettere una barra ( / ) in colonna B (unita con c,d,e,f) da riga 48 a riga 55, potresti metterci un codice univoco. A quel punto il gioco sarebbe fatto: cerchi la riga di tale codice univoco e ne cancelli il contenuto.

Altro non so dirti

saluti




Domenico
Win 10 - Excel 2016
Post: 3
Registered in: 3/16/2020
Age: 25
Junior User
ultima
OFFLINE
3/18/2020 1:08 PM
 
Modify
 
Delete
 
Quote

grazie
Buongiorno, grazie dodo47 per il tuo aiuto e per gli altri che si sono cimentati nella marea di codice che ho prodotto.

Saluti.
Post: 5,850
Registered in: 11/14/2004
Master User
Office 2019
OFFLINE
3/18/2020 3:40 PM
 
Modify
 
Delete
 
Quote

Prova di scrittura
sto cercando di scrivere una risposta

ciao by sal [SM=x423051]
se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie





Iscriviti al nuovo sito che ho aperto troverai altre RISPOSTE
https://www.bysal-excel.it
Admin Thread: | Close | Move | Delete | Modify | Email Notification Previous page | 1 | Next page
New Thread
 | 
Reply
Cerca nel forum
Tag discussione
Discussioni Simili   [vedi tutte]
Home Forum | Bacheca | Album | Users | Search | Log In | Register | Admin
Tutti gli orari sono GMT+01:00. Adesso sono le 6:24 AM. : Printable | Mobile | Regolamento | Privacy
FreeForumZone [v.5.2] - Copyright © 2000-2020 FFZ srl - www.freeforumzone.com