Impossible de charger ma listview

Le 08/04/2018 à 02:54

Bonjour a tous

ma listview a le plus grand mal a se charger deja sur 10 lignes

et moi j'aurai besoin de travail sur au moins 60000 lignes

si vous avez une solution pour optimiser le chargement de la listview

merci d'avance

Private Declare Function FindWindowA& Lib "User32" (ByVal lpClassName$, ByVal lpWindowName$)
Private Declare Function EnableWindow& Lib "User32" (ByVal hWnd&, ByVal bEnable&)
Private Declare Function GetWindowLongA& Lib "User32" (ByVal hWnd&, ByVal nIndex&)
Private Declare Function SetWindowLongA& Lib "User32" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)
Option Compare Text 'Pour ignorer les majuscules ou minuscules
Option Explicit

Dim Mem_Code_Art        'pour retrouver ligne excel si modif code art

Private Sub Majour_Lsvw_Click()
    'majour listview
    Call Majour_Lvw
End Sub

Private Sub TextBox3_Change()
    If TextBox3 = "Néant" Then
        TextBox12.ForeColor = vbRed
        TextBox2.ForeColor = vbRed
        TextBox3.ForeColor = vbRed
        TextBox4.ForeColor = vbRed
        TextBox5.ForeColor = vbRed
        TextBox6.ForeColor = vbRed
        TextBox7.ForeColor = vbRed
        TextBox8.ForeColor = vbRed
        TextBox9.ForeColor = vbRed
        TextBox10.ForeColor = vbRed
    Else
        TextBox12.ForeColor = vbBlack
        TextBox2.ForeColor = vbBlack
        TextBox3.ForeColor = vbBlack
        TextBox4.ForeColor = vbBlack
        TextBox5.ForeColor = vbBlack
        TextBox6.ForeColor = vbBlack
        TextBox7.ForeColor = vbBlack
        TextBox8.ForeColor = vbBlack
        TextBox9.ForeColor = vbBlack
        TextBox10.ForeColor = vbBlack
    End If
End Sub

Private Sub TextBox1_Change()
    Dim I As Long
    Dim C As Range

    ListView1.ListItems.Clear
    If TextBox1 <> "" Then
        With Sheets("BIBLIOTHEQUE DE PRIX TCE")
            I = 2
            Do
                For Each C In .Range(.Cells(I, 1), .Cells(I, 10))
                    If UCase(CStr(C.Value)) = UCase(TextBox1.Value) Or InStr(CStr(C), TextBox1) > 0 Then
                        IniLvw12 C.Row
                        Exit For
                    End If
                Next C
                I = I + 1
            Loop While .Cells(I, 1) <> ""
        End With
    Else
        Me.TextBox2 = ""
        Me.TextBox3 = ""
        Me.TextBox4 = ""
        Me.TextBox5 = ""
        Me.TextBox6 = ""
        Me.TextBox7 = ""
        Me.TextBox8 = ""
        Me.TextBox9 = ""
        Me.TextBox10 = ""
        Me.TextBox12 = ""       'code art
        Call Majour_Lvw      'majour listview
    End If
End Sub

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    ListView1.Sorted = False
    ListView1.SortKey = ColumnHeader.Index - 1
    If ListView1.SortOrder = lvwAscending Then
        ListView1.SortOrder = lvwDescending
    Else
        ListView1.SortOrder = lvwAscending
    End If
    ListView1.Sorted = True
    'Unload Me
    'CONSULTATION_PRIX.Show
End Sub

Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
    Dim I As Integer
    Dim J As Integer

    Dim x
    I = Me.ListView1.SelectedItem.Index
    TextBox12 = ListView1.ListItems(I)
    Mem_Code_Art = TextBox12.Value
    For J = 1 To Me.ListView1.ColumnHeaders.Count - 1
        Me.Controls("Textbox" & J + 1) = ListView1.ListItems(I).ListSubItems(J).Text
    Next J
  'Unload Me
  'CONSULTATION_PRIX.Show
End Sub

Sub IniLvw12(a As Long)
    Dim x
    Dim I
    Dim J
    Dim C
    With ListView1
        .ListItems.Add , , Sheets("BIBLIOTHEQUE DE PRIX TCE").Cells(a, 1)
        For I = 1 To 9
            .ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("BIBLIOTHEQUE DE PRIX TCE").Cells(a, I + 1)
        Next
        .ListItems(.ListItems.Count).ListSubItems.Add , , a
        For I = 1 To .ListItems.Count
            If .ListItems(I) = TextBox1 Then .ListItems(I).Bold = True
            For J = 1 To .ColumnHeaders.Count - 1
                If .ListItems(I).ListSubItems(2).Text = "Néant" Then
                    .ListItems(I).Bold = True
                    .ListItems(I).ForeColor = vbRed
                    For C = 1 To .ColumnHeaders.Count
                        .ListItems(I).ListSubItems(C).Bold = True
                        .ListItems(I).ListSubItems(C).ForeColor = vbRed     'couleur colonne 2
                    Next C
                End If
            Next J
        Next I
    End With
End Sub

Private Sub UserForm_Activate()
    EnableWindow FindWindowA("XLMAIN", Application.Caption), 1
End Sub

Private Sub UserForm_Initialize()
    Dim hWnd As Long
    Dim ligne

    hWnd = FindWindowA(vbNullString, Me.Caption)
    SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) Or &H20000
    With Me.ListView1
        With .ColumnHeaders
            .Clear
            .Add , , "Code art.", 70, lvwColumnLeft
            .Add , , "Type Ets", 55, lvwColumnCenter
            .Add , , "Nom Ets (Client)", 95, lvwColumnCenter
            .Add , , "Désignation", 220, lvwColumnCenter
            .Add , , "D.U. (F)", 60, lvwColumnCenter
            .Add , , "D.U. (D/P)", 60, lvwColumnCenter
            .Add , , "D.U. (ST)", 50, lvwColumnCenter
            .Add , , "Unité", 35, lvwColumnCenter
            .Add , , "Qté", 50, lvwColumnCenter
            .Add , , "Sous-traitant", 140, lvwColumnCenter
        End With
        ligne = 1
        .Gridlines = True
        .View = lvwReport
        .FullRowSelect = True
        Majour_Lvw
    End With
End Sub

Sub Majour_Lvw()
    Dim Nbl As Long, I As Long, J As Long, C As Range

    ListView1.ListItems.Clear
    'If TextBox12 = "" Then
        With Sheets("BIBLIOTHEQUE DE PRIX TCE")
            I = 2
            J = .Range("A456541").End(xlUp).Row
            For Each C In .Range("A2:A" & .Range("A456541").End(xlUp).Row)
                Call IniLvw_Maj(C.Row)
            Next C
        End With
    'Else
    '    MsgBox "Attention code article vide---------------Majour_Lvw!!!!!!"
    'End If
End Sub

Sub IniLvw_Maj(a As Long)
    Dim x
    Dim I
    Dim J
    Dim C
    With ListView1
        .ListItems.Add , , Sheets("BIBLIOTHEQUE DE PRIX TCE").Cells(a, 1)
        For I = 1 To 9
            .ListItems(.ListItems.Count).ListSubItems.Add , , Sheets("BIBLIOTHEQUE DE PRIX TCE").Cells(a, I + 1)
        Next
        .ListItems(.ListItems.Count).ListSubItems.Add , , a
        For I = 1 To .ListItems.Count
            If .ListItems(I) = TextBox1 Then .ListItems(I).Bold = True
            For J = 1 To .ColumnHeaders.Count - 1
                If .ListItems(I).ListSubItems(2).Text = "Néant" Then
                    .ListItems(I).Bold = True
                    .ListItems(I).ForeColor = vbRed
                    For C = 1 To .ColumnHeaders.Count
                        .ListItems(I).ListSubItems(C).Bold = True
                        .ListItems(I).ListSubItems(C).ForeColor = vbRed     'couleur colonne 2
                    Next C
                End If
            Next J
        Next I
    End With
End Sub
30bl-listview-bis.xlsm (861.72 Ko)
Le 08/04/2018 à 11:20

Bonjour

trop de ligne pour la memoire

fait une Listbox a la place

A+

Maurice

Le 08/04/2018 à 11:38
archer a écrit :

Bonjour

trop de ligne pour la memoire

fait une Listbox a la place

A+

Maurice

Bonjour a tous c'est long meme avec une dizaine de ligne

j'ai besoin de colorer les lignes sous condition d'ou la listview

se n'ai apparemment pas possible avec une listbox

si tu a une solution merci d'avance

Le 08/04/2018 à 11:59

Bonjour

voila une nouvelle listview sur 1000 ligne

A toi de voir

A+

Maurice

26bl-listview-bis.xlsm (872.79 Ko)
Le 08/04/2018 à 12:21

Bonjour,

pas tout compris au coloriage mais mis en bleu et rouge

mis en commentaire le textbox1change car sur 80000 lignes pas adequate

il vaut mieux remplir la listview en une seule fois plutot que de reprendre les données de la listview avec une double boucle pour mettre en gras et en couleur

bonne continuation

24bl-listview-bis-2.xlsm (862.07 Ko)
Le 08/04/2018 à 12:48
BOB71AU a écrit :

Bonjour,

pas tout compris au coloriage mais mis en bleu et rouge

mis en commentaire le textbox1change car sur 80000 lignes pas adequate

il vaut mieux remplir la listview en une seule fois plutot que de reprendre les données de la listview avec une double boucle pour mettre en gras et en couleur

bonne continuation

Bonjour et merci

et du coup comment faire une recherche dynamique dans la listview

Cordialement

Le 08/04/2018 à 13:33

Re

Par un bouton ou par afterupdate mais pas par textboxchange

Le 08/04/2018 à 14:56

Re

avec recherche et tu peux choisir ta colonne

dernier envoie

A+

Maurice

18bl-listview-bis.xlsm (879.19 Ko)
Le 08/04/2018 à 15:23
BOB71AU a écrit :

Re

Par un bouton ou par afterupdate mais pas par textboxchange

Re

J'ai remplacer change par afterupdate mais ne fonction pas

Private Sub TextBox1_AfterUpdate()
    Dim I As Long
    Dim C As Range

    ListView1.ListItems.Clear
    If TextBox1 <> "" Then
        With Sheets("BIBLIOTHEQUE DE PRIX TCE")
            I = 2
            Do
                For Each C In .Range(.Cells(I, 1), .Cells(I, 10))
                    If UCase(CStr(C.Value)) = UCase(TextBox1.Value) Or InStr(CStr(C), TextBox1) > 0 Then
                        IniLvw12 C.Row
                        Exit For
                    End If
                Next C
                I = I + 1
            Loop While .Cells(I, 1) <> ""
        End With
    Else
        Me.TextBox2 = ""
        Me.TextBox3 = ""
        Me.TextBox4 = ""
        Me.TextBox5 = ""
        Me.TextBox6 = ""
        Me.TextBox7 = ""
        Me.TextBox8 = ""
        Me.TextBox9 = ""
        Me.TextBox10 = ""
        Me.TextBox12 = ""       'code art
        Call Majour_Lvw      'majour listview
    End If
End Sub
Le 08/04/2018 à 18:15

Rere

dans ton code, tu recommence tes boucles

j'ai donc modifié le code du afterupdate mais la prochaine étape est le find pour éviter les boucles

Le 08/04/2018 à 19:12

Bonjour

sur un tableau tu peux pas faire un delete

j'ais refait la base sans décor pour etre tranquile

et la ses vraiment ma dernieres reponse

A+

Maurice

17bl-listview-1.xlsm (854.50 Ko)
Le 08/04/2018 à 19:58
archer a écrit :

Bonjour

sur un tableau tu peux pas faire un delete

j'ais refait la base sans décor pour etre tranquile

et la ses vraiment ma dernieres reponse

A+

Maurice

BL_ListView-1.xlsm

Re

Super merci beaucoup pour le coup de main

Cordialement

Rechercher des sujets similaires à "impossible charger listview"