Autres Problème de compréhension macro

JPaul13

XLDnaute Nouveau
Bonjour à Tous les membres du club

Comme évoqué hier en fin cette nuit je suis nouveau et je vais vous présenter un problème que je souhaiterai résoudre et sur lequel je but depuis plusieurs semaines.
Actuellement mon code fonctionne très bien ; il s'agit de transférer les données d'une feuille excel du même classeur vers ma listview de mon USERFORM mode plein écran.
Le soucis est que lorsque je transfert plus 5000 lignes sur 15 colonnes j'ai un ralentissement ce qui est très gênant au visuel car on retrouve l'arrière plan de mon excel.

voici mon code actuel sur 8 colonnes qui peut être à besoin d’être corrigé

Private Sub Userform_Initialize() 'Mise a jour Listview
Dim I As Long
With ListView1
With .ColumnHeaders 'titre de la colonne et largeur et alignement
.Clear
.Add , , "PK", 40
.Add , , "Traverse", 40
.Add , , "Rail", 30
.Add , , "Tracé", 30
.Add , , "Devers", 40
.Add , , "Profil", 30
.Add , , "Caténaires", 45
.Add , , "Val Dég", 35
End With
With Me
.Zoom = 100 * (Application.Height / Me.Height)
.startUpPosition = 3
.Width = Application.Width
.Height = Application.Height
.Left = 0
.Top = 0
End With
.View = lvwReport
.FullRowSelect = True
.Gridlines = True

For I = 2 To Sheets.[_Default]("Sheet1").Range("A65536").End(xlUp).Row
.ListItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 1)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 2)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 3)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 4)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 5)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 6)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 7)
.ListItems(.ListItems.Count).ListSubItems.Add , , Sheets.[_Default]("Sheet1").Cells(I, 8)
If Sheets.[_Default]("Sheet1").Cells(1, 20) = 0 Or Sheets.[_Default]("Sheet1").Cells(I, 8) < Sheets.[_Default]("Sheet1").Cells(1, 20) Then
.ListItems(.ListItems.Count).ListSubItems(7).ForeColor = &H80000008 ' Couleur Bleu
Else
.ListItems(.ListItems.Count).ListSubItems(7).ForeColor = &HFF& 'Couleur Rouge
End If
TextBox3.Value = ThisWorkbook.Sheets("Sheet1").Range("T1")
Next
End With
End Sub

Maintenant en fouillant sur le net j'ai trouvé un code qui apparemment réduit considérablement les exécutions de transfert, mais je n'arrive pas à l'adapter à mon code.
Code présenté tel quel , les libélés (Lib A) et quantités sont bien évidement à adapté à mon codage.

Sub Methode_B()
Dim monForm As New UserForm1
Dim i As Long
Dim mesValeurs(99, 4) As Variant
For i = 0 To 99
mesValeurs(i, 0) = i 'on inscrit par exemple un identifiant unique de ligne
mesValeurs(i, 1) = "lib_A_" & i 'on inscrit le libellé de 1ère colonne
mesValeurs(i, 2) = "lib_B_" & i 'on inscrit le libellé de 2ème colonne
mesValeurs(i, 3) = "lib_C_" & i 'on inscrit le libellé de 3ème colonne
mesValeurs(i, 4) = "lib_D_" & i 'on inscrit le libellé de 4ème colonne
Next i
monForm.ListBox1.List = mesValeurs 'on charge les valeurs en une fois dans le contrôle ListBox1
monForm.Show
End Sub

Je pense avoir été assez clair et attend avec impatience vos commentaires et encore mieux une ou des réponses.
Vous remerciant par avance
 

jmfmarques

XLDnaute Accro
Bonjour
L'évènement initialize est à déconseiller vivement pour gérer les aspects graphiques. Lors de cet évènement, les contrôles graphiques sont encore en cours de chargement.
utiliser l'évènement Activate.

ps : ce qui ne veut pas dire, loin de là, que je trouve bonne l'idée de l'utilisation d'une listview qui n'est pas un contrôle natif de VBA et posera donc, tôt ou tard, des problèmes de portabilité.
 

eriiic

XLDnaute Barbatruc
Bonjour à tous,

En plus de la remarque de jfmarques, l'exemple que tu as adapté n'était pas pour une colonne unique ?
Il me semble qu'il n'y a pas d'autre méthode que .Add pour un listview multi-colonnes.
Edit : Oupss, je n'avais pas vu listbox..., sorry
Edit 2 : ah mais je n'avais pas rêvé, tu as un listview que tu cherches à utiliser comme un listbox...
Décide-toi, ce n'est pas pareil

Si tu vas sur un listbox :
VB:
ListBox1.List() = Range("A1:D5000").Value

Et si tu ajoutes Application.ScreenUpdating = false en 1èle ligne du code ça donne quoi ?
eric
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour @JPaul13, bienvenue dur XLD :),

Voir une piste dans le fichier avec la propriété RowSource:
VB:
Private Sub UserForm_Initialize()
Dim DerLig&

   With Sheets("Feuil1")
      If .FilterMode Then .ShowAllData
      DerLig = .Cells(.Rows.Count, "b").End(xlUp).Row
      ListBox1.ColumnCount = 15
      ListBox1.RowSource = .Range("b2").Resize(DerLig - 1, 15).Address
      ListBox1.ColumnHeads = True
   End With
End Sub

Nonjour @fanch55 :)
La comparaison n'est pas pertinente, listview et listbox sont deux objets différents .
La source de la listview est une Table structurée ?

Comme d 'hab. et c'est de plus en plus fréquent, aucun fichier fourni : Pas de bras, pas de chocolat.
De toute façon, je n'utilise pas de ListView par principe. On a déjà une feuille de calcul (avec MFC possibles, formats des nombres, couleurs des fonds et des polices et toutes les possibilités natives d'Excel). Pourquoi aller recréer un tableur minimaliste qui fait doublon ? Et je ne parle pas des PB de version que j'ai déjà rencontrés.
 

Pièces jointes

  • JPaul13- classeur fait main!!! v1.xlsm
    620.9 KB · Affichages: 12
Dernière édition:

fanch55

XLDnaute Barbatruc
Bon, on me dira que j'ai que ça à foutr... ( c'est vrai !!! )

J'ai testé avec une table de même dimension que la votre .
Ma dernière utilisation des listviews date de Vb6 .

Excel 64 bits, 16 go de ram , un vieux cpu intel Quad core mais avec une pêche d'enfer .
Listview : 1,7 secondes
Listbox : moins d'une seconde .
Et tout celà sans "scintellement" .

Pour vérifier, j'ai testé sur un portable avec 4go et un Cpu amd e-je ne me souviens plus.
J'ai pleuré : près de 4 secondes pour le listview , et 2 sd pour le listbox et beaucoup de "rafraichissement écran", même en faisant des hide .

Bref, votre code ne peut être mieux optimisé mais dépend de l'architecture du système .

La listbox fait mieux , ce n'est pas étonnant, elle travaille "en bloc de masse" avec le code adéquat, la listview se laisse construire ... ;)

Après y'a plus plus tout le "confort" du Listview qui se résume en "afficher les headers" et colorier certaines cellules .

Voilà, c'est juste une question de goûts et de couleurs .... tant que le listview fonctionne .
:cool:

Nota: je n'ai jamais réussi à faire de rowsource avec un listview, mais je suis prêt à savoir comment .
 

JPaul13

XLDnaute Nouveau
Wahoo !!

Je n'attendais pas autant de réponses aussi rapides; je tiens déjà a vous remercier.
Je vais tester les différentes méthodes proposé et adapter tout çà.

Effectivement je n'ai pas joint de fichiers car c'était la première fois que je postais une demande.
Le choix de la listview est du fait que sur une autre macro non présenté je peux faire ressortir des valeurs hors tolérances en code couleur selon valeur d'un textbox.

Dans tous les cas je vais avancer et je vous soumettrez mon fichier.

Encore Merci de votre collaboration
 

JPaul13

XLDnaute Nouveau
Bonjour à tous,

En plus de la remarque de jfmarques, l'exemple que tu as adapté n'était pas pour une colonne unique ?
Il me semble qu'il n'y a pas d'autre méthode que .Add pour un listview multi-colonnes.
Edit : Oupss, je n'avais pas vu listbox..., sorry
Edit 2 : ah mais je n'avais pas rêvé, tu as un listview que tu cherches à utiliser comme un listbox...
Décide-toi, ce n'est pas pareil

Si tu vas sur un listbox :
VB:
ListBox1.List() = Range("A1:D5000").Value

Et si tu ajoutes Application.ScreenUpdating = false en 1èle ligne du code ça donne quoi ?
eric

Bonjour Eric

Je te répond directement car effectivement mon code fonctionne pour une listbox, et j'ai trouvé sur internet un modelé de code qui lui est établi pour une listbox et je voulais savoir si ce code pouvait être exécuté avec modifs approprié vers une listbox; mais je vais essayer tes propositions et quand j'aurai avancé un peu plus je vous transfert mes fichiers.

bien à toi
 

fanch55

XLDnaute Barbatruc
Re-bonjour le Fil .
Bon, on me dira que j'ai que ça à foutr... ( c'est vrai !!! )

Pour être dans la continuité,
Je me suis donc focalisé sur le ListBox :
1589035108189.png

Pas mal, 50 000 lignes en 13 centièmes de secondes.

Je me suis même planté à un moment en générant plus de 500 000 lignes :
1589035230197.png

Waoow, 522 882 lignes en 20 centièmes de secondes !!!!!
C'est plus rapide de générer cet userform et d'y naviguer que dans la Feuille ...( fichier de 50 mo
quand même ... )

Le code pour l'Userform est archi simple :
1 listbox, 1 label
VB:
Option Explicit
Dim T As Single
Private Sub UserForm_Activate()
Dim Table       As ListObject
Dim W_Columns   As String
Dim Cell        As Range
 
   '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
   ' c'est là où on indique quel est le tableau concerné
    Set Table = [T_BDDTECHNIQUE].ListObject
   '-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
   
   ' on s'adapte à la largeur des colonnes sources
   ' pas tout à fait vrai, dépend des polices
    For Each Cell In Table.HeaderRowRange.Cells
        W_Columns = Trim(W_Columns & Cell.Width & ";")
    Next
   
    With Me.ListBox1
        .ColumnCount = Table.Range.Columns.Count
        .ColumnWidths = W_Columns ' sinon pas de scrollbar horizontale
        .ColumnHeads = True
        .RowSource = Table.DataBodyRange.Address
    End With
   
    Me.Label1 = Table.Range.Columns.Count & " colonnes , " & _
                Table.Range.Rows.Count & " lignes " & _
                "en " & Format(Timer - T, "#0.00") & " secondes"

End Sub
Private Sub UserForm_Initialize()
   
    Me.Hide
    T = Timer
             Me.Move 0, 0, Application.UsableWidth, Application.UsableHeight
      Me.Label1.Move 0, 0, Me.InsideWidth
    Me.ListBox1.Move 5, Me.Label1.Height, Me.InsideWidth - 10, Me.InsideHeight - Me.Label1.Height

End Sub
Je joins le Frm pour ceux que cela intéresse : fonctionne avec tous les tableaux structurés .
 

Pièces jointes

  • UF_Listbox.zip
    1.4 KB · Affichages: 8

JPaul13

XLDnaute Nouveau
Bonsoir Fanch55

J'ai essayé de mettre en place ton code et je n'arrive pas à la lancer.
Je ne suis pas un expert VBa ; j'ai fais un tableau structuré et nommé
j'ai inséré ton code dans ma feuille code userform
Userform avec listbox

Lorsque j’exécute le programme il bloque pour erreur LAbel1 "menbre de méthodes ou données introuvables"

Je ne doute en aucuns cas de ton code, j'ai certainement loupé QQch.

pour infos j'ai fais le test sur un nouveau classeur.

Merci d'avance
 

Pièces jointes

  • TEST_1.xlsm
    709.4 KB · Affichages: 3

fanch55

XLDnaute Barbatruc
J'avais inclus un contrôle Label1 pour afficher les infos de construction .
Tu n'as pas de Label1 sur ton userform, il faut enlever les codes de celui-ci .
Le fichier joint devrait fonctionner ...
 

Pièces jointes

  • TEST_1.xlsm
    709.3 KB · Affichages: 4

Discussions similaires

Statistiques des forums

Discussions
315 093
Messages
2 116 140
Membres
112 669
dernier inscrit
Guigui2502