› Sviluppare funzionalita su Microsoft Office con VBA › Ordinamento Automatico Righe
-
AutoreArticoli
-
Pero' nel codice c'e' gia' l'istruzione giusta: LI.ListSubItems(i).ForeColor = co
Adesso verifico se funziona o no 🙂
Ah ecco... non funziona perche' le righe nascoste vengono rivisualizzate ai fini del funzionamento del Find pertanto questa istruzione
If f.EntireRow.Hidden Then co = 8421504 Else co = vbBlack 'grigio per le righe nascosteprodurra' solo co=vbBlack
...questo perche' e' stata modificata la Sub active_table rispetto alla mia versione, prevedendo di scoprire le righe che prima erano nascoste (presumo perche' il Find non funziona)
Ma io infatti ricordavo che funzionasse tutto in questo senso poi evidentemente per sistemare qualcosa abbiamo scoperto le righe nascoste perché se facevo una ricerca e tra questa ricerca c'era una riga nascosta andava in debug. Come possiamo risolvere secondo te? A me sta bene che le righe nascoste non si vedano e non si riescano a cercare. Ma se proprio si devono vedere che va pure bene se si vedono grigie è meglio
Allora usiamo un workaround semplice; dal momento che sappiamo che le righe nascoste sono quelle inferiori alla data odierna, ci basta controllare non se la riga e' nascosta ma se la data e' minore di oggi per restituire il colore grigio invece che nero per tingere le righe della listview.
In soldoni ecco il codice che sostituisce il precedente in listview_populate:
If f.Offset(, 1) < Date Then co = 8421504 Else co = vbBlack 'grigio per le righe nascosteCome dice troppo spesso ChatGPT, chiedo scusa se ho equivocato o frainteso la tua richiesta
non so perchè è saltata questa macro che resetta il foglio eliminando tutte le righe e ripartendo da zero:
Option Explicit Sub Elimina_dal_rigo_nr_4() Dim sh As Worksheet Dim ur As Long For Each sh In ThisWorkbook.Worksheets If sh.Name <> "Pannello di Controllo" Then sh.Activate ur = sh.Cells(Rows.Count, "A").End(xlUp).Row If ur > 3 Then Rows("4:" & ur).Delete End If End If Next sh End Submi correggo, se la faccio partire va in debug ma se la provo con f8 mi elimina tutte le righe cosa ci sarà che gli da fastidio
Allegati:
You must be logged in to view attached files.se la faccio partire va in debug ma se la provo con f8 mi elimina tutte le righe
A me funziona senza problemi. Quand'è che lanci questa Sub? Io l'ho provata direttamente premendo il Play nell'Editor VBE
Ciao Alex,
intanto volevo ringraziarti per tutto l'aiuto che mi hai dato non solo su questo fronte.
Guarda anche a me se entro nell'editor e lancio play mi funziona. Se invece clicco su Macro e dalla lista clicco esegui istruzioni mi va in debug. Cmq diciamo che serve una volta l'anno quindi ha poca importanza.
Lascerò il post un po aperto, in questi giorni vedo di resettare tutto e fare un inserimento massivo di dati per vedere come si comporta il file. Vi darò aggiornamento prima di chiudere.
Grazie ancora
Ma nooo...non va in Debug. Ti porta all'istruzione senza eseguirla. Se invece vuoi eseguirla direttamente devi premere sul pulsante ESEGUI e non ESEGUI ISTRUZIONE.
mi sono rin...........Si hai ragione facevo una cosa per un altra
Ciao Alex,
ho un problema con questo codice:
Public Sub Pulisci_TextBox_e_ListView(frm As Object) Dim i As Integer With frm For i = .ListView1.ListItems.Count To 1 Step -1 If .ListView1.ListItems(i).Selected = True Then .ListView1.ListItems.Remove (i) End If Next i For i = 3 To active_table(frm).Columns.Count - 1 frm.Controls("Textbox" & i) = "" Next frm.Controls("TextboxA") = "" frm.Controls("TextboxB") = "" End With End SubQuando lo uso per l'userform transfer funziona mentre quando lo uso per gli altri userform elimina la riga ma va in debug quando punta alla TextboxA che negli altri userform non c'è. Quindi immagino vada generalizzata oppure doppiato il codice in transfer e tutti gli altri userform.
----------------------------------------------------
Un'altra stranezza è sul tasto elimina del foglio transfer, che funziona ma se io provo ad eliminare un numero indefinito di righe (nel senso che le elimino una dopo l'altra, in genere massimo una decina di righe e ti esce, e non ho capito in quale momento va in debug) va in debug con l'errore che ti allego come immagine.
Ti allego anche un file prova con una serie di righe inserite anonime, cosa provare:
1. premi il tasto elimina su qualsiasi userform (tranne transfer) va in debug subito, ma elimina lo stesso la riga
2. fai una ricerca in una textbox del foglio userform scrivendo "???" ti restituirà tutte le righe, elimina una ad una le righe, vedrai che funziona ma stai sicuro che ad un certo punto ti da l'errore.
Grazie mille
Allegati:
You must be logged in to view attached files.Ecco...come ti dicevo...essendo un progetto manipolato da più persone...giustamente capitano queste cose. Allora i due problemi sono in un certo modo legati tra loro. In pratica come hai sottolineato le TextBoxA e TextBoxB esistono solo nella UserForm dei Trasfer. Quindi quando si avvia la macro da un'altra UserForm che svuota le TextBox, questa ovviamente impazzisce perché non le trova. Ora il problema si risolve con un altro tipo di ciclo (il For Each...Next). L'ho provato è funziona.
Nella versione che ti giro troverai il codice all'interno della Public Sub Pulisci_TextBox_e_ListView(frm As Object). Però ti dico subito che non va bene (e quindi non la faccio lanciare) per il secondo problema che mia hai evidenziato e ti spiego il perché:
Il secondo problema nasce dal fatto che quando tu effettui una ricerca globale con i famosi ??? (e per info puoi anche usare il simbolo dell'asterisco "*"...uno solo basta), vai a popolare la ListView di tutti i nominativi....giusto? Ora, facendo un esempio, la ricerca ha trovato 30 nominativi. Quando tu elimini un nominativo...diciamo il numero 10, la ListView rimane così com'era ma in realtà dovrebbe aggiornarsi perché quelli che vengono dopo il numero 10 dovrebbero scalare...tant'é che il numero 30 non dovrebbe più esistere, anzi dovrebbe diventare nr. 29, invece rimane ancora nr. 30. A quel punto se tu provi a eliminare il numero 30...siccome tu in tabella sul foglio non ce l'hai più perché è scalato al numero 29 (sto parlando sul Foglio)....allora ecco il debug.
Ora che ho fatto io....ho fatto in modo che ogni qual volta tu elimini un nominativo, la ListView si riaggiorna ma le TextBox non possiamo cancellarle perché altrimenti la ListViev non riesce ad aggiornarsi. Perché si riaggiorna grazie al dato presente in TexBox...ma se lo cancelliamo non riesce ad aggiornarsi.
E cmq questo problema non è vero che ce l'hai solo nella Form dei Transfer....tu nelle altre form non effettui ricerche globali...ma prova ad aprire un'altra UserForm e metti l'asterisco in un campo e vedi che la ListView si popola di tutti i dati. Prova a cancellare un nominativo, poi prova a cancellare l'ultimo e vedrai che avrai lo stesso problema che hai evidenziato....questa prova ovviamente la devi fare sulla tua versione e non su questa che ti ho allegato ora.
Cmq magari vediamo se V_F gli da uno sguardo anche lui alle modifiche che ho fatto...perché non vorrei aggiustare da una parte e rovinare dall'altra.
Allegati:
You must be logged in to view attached files.Ciao Alex,
ma figurati so benissimo che aggiusti da una parte e magari si sbaglia dall'altra, ci abbiamo lavorato tanto con VF e non è un lavoro di un giorno ma di mesi aggiusta qui aggiusta la, anzi grazie.
Allora ho fatto un po di prove:
Ora il problema si risolve con un altro tipo di ciclo (il For Each...Next). L'ho provato è funziona.
ok problema sembra risolto.
Ora che ho fatto io....ho fatto in modo che ogni qual volta tu elimini un nominativo, la ListView si riaggiorna ma le TextBox non possiamo cancellarle perché altrimenti la ListViev non riesce ad aggiornarsi. Perché si riaggiorna grazie al dato presente in TexBox...ma se lo cancelliamo non riesce ad aggiornarsi.
Guarda come soluzione non è male nel senso che raggiunge lo scopo, l'unico problema lo ho quando faccio doppio click, nel senso che io ho due modi per eliminare una riga:
1. seleziono la riga e la elimino, quindi nelle textbox mi rimane solo il campo/i ricercati
2. faccio doppio click sulla riga, mi popola le textbox, clicco su elimina e mi rimangono tutti i campi del doppio click (ecco qui se si potesse in questo caso fare qualcosa tipo chiudi l'userform se hai fatto doppio click prima di elimina riga - esempio messo la chiaramente)
Ad ogni modo problemi di poco conto nel senso che il funzionamento generale va bene. Passiamo ai problemi che ho scovato:
Allora ci sono 2 tipi di errore che mandano in debug:
1. Autofill, quando capita: elimina tutte le righe una ad una di un foglio (io ho provato sui transfer) quando elimini la penultima riga arriva il debug
2. quando capita il secondo errore: elimina tutte le righe una ad una di un foglio quando elimini l'ultima riga va in debug ma questo è legato sicuramente al fatto che quando elimini l'ultima riga non trova più nulla e non riesce ad aggiornare la listview e va in debug
La nostra luce
VF è sempre il benvenuto, ma piano piano risolviamo mi hai risolto mille problemi, grazie mille Allegati:
You must be logged in to view attached files.eh ma se ci dai una mano non è che ci offendiamo anziiiiii
1. Autofill, quando capita: elimina tutte le righe una ad una di un foglio (io ho provato sui transfer) quando elimini la penultima riga arriva il debug
Naturalmente Autofill va in crash quando non ci sono due righe da autofillare. Fai un check sul numero di righe rimaste per evitare l'Autofill.
In cancella_record:
Set r = active_table(frm) If r.Rows.Count > 1 Then Set r = r.Offset(1).Resize(r.Rows.Count - 1, 1) r(1) = 1 If r.Rows.Count > 2 Then r(1).AutoFill r, xlFillSeries End IfQuesto dovrebbe risolvere entrambi i problemi.
Public Sub Cancella_Record_in_Tabella(frm As Object) Dim r As Range, f As Range Dim LI As ListItem Dim i As Byte Set LI = frm.ListView1.SelectedItem If LI Is Nothing Then Exit Sub i = MsgBox("Sei sicuro di voler cancellare il record scelto?", vbQuestion + vbYesNo + vbDefaultButton2, "Attenzione...") If i = vbNo Then Exit Sub Set r = active_table(frm) If r.Rows.Count > 1 Then Set r = r.Offset(1).Resize(r.Rows.Count - 1, 1) r(1) = 1 If r.Rows.Count > 2 Then r(1).AutoFill r, xlFillSeries End If Set r = active_table(frm) Set r = r.Offset(1).Resize(r.Rows.Count - 1) Set f = r.Columns(1).Find(LI, LookIn:=xlValues, LookAt:=xlWhole) f.EntireRow.Delete Set r = active_table(frm) Set r = r.Offset(1).Resize(r.Rows.Count - 1, 1) r(1) = 1 r(1).AutoFill r, xlFillSeries Call Pulisci_TextBox_e_ListView(frm) End Subsbaglio qualcosa?
l'errore cosi rimane
sbaglio qualcosa?
Si'... guarda meglio il mio esempio che non e' un esempio ma la soluzione
Public Sub Cancella_Record_in_Tabella(frm As Object) Dim r As Range, f As Range Dim LI As ListItem Dim i As Byte Set LI = frm.ListView1.SelectedItem If LI Is Nothing Then Exit Sub i = MsgBox("Sei sicuro di voler cancellare il record scelto?", vbQuestion + vbYesNo + vbDefaultButton2, "Attenzione...") If i = vbNo Then Exit Sub Set r = active_table(frm) Set r = r.Offset(1).Resize(r.Rows.Count - 1) Set f = r.Columns(1).Find(LI, LookIn:=xlValues, LookAt:=xlWhole) f.EntireRow.Delete Set r = active_table(frm) If r.Rows.Count > 1 Then Set r = r.Offset(1).Resize(r.Rows.Count - 1, 1) r(1) = 1 If r.Rows.Count > 2 Then r(1).AutoFill r, xlFillSeries End If If frm.Caption = "TRANSFER" Then Call Inserisci_Riga_TransferNew.btnSearch_Click Else Call form_search(frm) End If 'Call Pulisci_TextBox_e_ListView(frm) End Subcosi sulla penultima non lo da ma quando rimane l'ultima e la elimino va in errore
Probabilmente il primo Resize si arrabbia se non trova righe da resizare in meno una.
`Public Sub Cancella_Record_in_Tabella(frm As Object) Dim r As Range, f As Range Dim LI As ListItem Dim i As Byte Set LI = frm.ListView1.SelectedItem If LI Is Nothing Then Exit Sub i = MsgBox("Sei sicuro di voler cancellare il record scelto?", vbQuestion + vbYesNo + vbDefaultButton2, "Attenzione...") If i = vbNo Then Exit Sub Set r = active_table(frm) If r.Rows.Count > 0 Then Set r = r.Offset(1).Resize(r.Rows.Count - 1) End If Set f = r.Columns(1).Find(LI, LookIn:=xlValues, LookAt:=xlWhole) f.EntireRow.Delete Set r = active_table(frm) If r.Rows.Count > 1 Then Set r = r.Offset(1).Resize(r.Rows.Count - 1, 1) r(1) = 1 If r.Rows.Count > 2 Then r(1).AutoFill r, xlFillSeries End If If frm.Caption = "TRANSFER" Then Call Inserisci_Riga_TransferNew.btnSearch_Click Else Call form_search(frm) End If 'Call Pulisci_TextBox_e_ListView(frm) End Sub`ho modificato cosi ed effettivamente non da l'errore sull'autofill ma sul search, anzi mi correggo anche prima dopo che abbiamo modificato il secondo resize da il debug sul search in questa sub qui "Public Sub form_search(frm As Object)"
Elimina tutte le righe ma quando vai sull'ultima da il debug qui
Ciao Frost, è da stamattina che ci metto mano...ovviamente non in maniera interrotta ehh...
...appena ho tempo.Non è affatto semplice aggiustare tutte le cose. Sistemo una e si rovina un'altra
.Cmq prova questa nuova versione che ti giro e vediamo come va. In pratica se esegui una ricerca e la ListView si popola di 2 elementi, se cancelli solo 1 dei 2 elementi allora le TextBox rimangono compilate. Ma se cancelli anche l'ultimo elemento, quindi la ListView rimane vuota, allora si svuotano anche le TextBox.
Nota bene che se fai doppio click nella ListView allora i dati del nominativo vanno a popolare le TextBox, a questo punto se cancelli il nominativo possono accadere 2 cose:
1) se il nominativo che hai eliminato ha dei duplicati allora la ListView rimane popolata meno quello che hai cancellato e le TextBox rimangono popolate
2) se il nominativo che hai eliminato NON ha duplicati (e per duplicati non intendo solo stesso nome e/o cognome, ma proprio tutto...anche nr. di passeggeri, data del transfer, ecc...), allora sia la ListView che le TextBox si svuotano.
Ti ho sistemato anche altri problemi che son venuti fuori mentre facevo le varie prove...ma io son convinto che ne usciranno degli altri
Allegati:
You must be logged in to view attached files.Ciao Alex,
Intanto grazie dell'impegno. Ho dato un occhiata ci sono alcuni movimenti che non mi quadrano e devo approfondire.
Come ho sempre detto a VF, questo file è molto importante perchè vengono segnate le note di tutti i clienti ed avere delle problematiche di cui magari non ti rendi conto potrebbe essere un problema serio.
Quindi va testato per bene. e ti aggiorno prima possibile.
Ho visto già una cosa che non ho capito quando succede se elimino molte righe una dopo l'altra ad un certo punto la numerazione si sfasa e non riesce ad eliminare perchè non trovo i numeri consequenziali. ma non ho capito dove e quando succede.
Si è molto complicato e ti dico la verità sono sempre un po preoccupato dai grossi cambiamenti anche perchè ad esempio nell'ultima versione quella precedente a questa le cose non andavano male anzi, se leggi la conversazione con VF stavamo sistemando poi ci siamo fermati.
Cmq ti aggiorno appena faccio delle prove approfondite.
Grazie mille
Ciao Alex,
Sto facendo delle prove di inserimento ed eliminazione approfondite, nel frattempo ti dico subito dell'unico problema che ho scovato fin ora, non sono riuscito a fare molte prove.
Praticamente, Elimina tutte le righe di un foglio una ad una, quando ti rimarranno solo 3 righe nella listview e vai ad eliminare un altra riga si sfasa la numerazione (rimangono 2 righe) invece di ordinarsi 1 e 2, si ordinano 1 e 3, non so perchè ma capita sempre cosi ho provato più volte. magari è una cavolata
Appena ho info più approfondite ti aggiorno
Grazie
Si hai ragione...avevo aggiunto un ulteriore controllo sul numero righe presenti in tabella e non avevo modificato il vecchio controllo aggiunto prima.
Cmq portati in MODULO2, vai in Public Sub Cancella_Record_in_Tabella(frm As Object, index As Long), portati al rigo sopra r(1).AutoFill r, xlFillSeries e modifica If r.Rows.Count > 2 Then con If r.Rows.Count > 1 Then (Occhio che ce ne sono 2 di questi If r.Rows...., a te interessa il secondo).
In pratica devi mettere 1 anziché 2
Per il resto? Funziona tutto?
-
AutoreArticoli
