marcod59
Messages postés170Date d'inscriptionvendredi 16 janvier 2004StatutMembreDernière intervention13 juin 2010
-
7 avril 2007 à 20:42
marcod59
Messages postés170Date d'inscriptionvendredi 16 janvier 2004StatutMembreDernière intervention13 juin 2010
-
9 avril 2007 à 23:17
Bonjour,
J'ai un programme qui affiche dans une listview 13 colonnes remplies par une base de donnée acces. Pour faire des tris par colonne j'ai mis des textbox qui font évoluer la listview à chaque frappe (voir le code un peu plus bas). Mon problème est que tant que la base n'est pas trop remplie, cela va relativement vite. Par contre, lorsqu'elle commence à se remplir (plus de 2000 entrée) ça commence à ramer un peu. Le problème étant que cette base va recevoir énormément de données, donc mon prog va ramer un max. Si quelqu'un avait une astuce pour que ça rame moins ça m'arrangerait. Voilà le code mis dans les textbox (ici 2 exemples, il y en a 4 dans le prog) :
Private Sub TXTCode_Change()
Critère = TXTcode.Text & "*" 'ne pas oublier de mettre .Text
monSQL = "SELECT releve.a, releve.b, releve.c, releve.d, releve.e, releve.f, releve.g, releve.h, releve.i, releve.j, releve.k, releve.l, releve.m FROM releve " _
& "WHERE releve.a Like '" & Critère & "'" _
& "ORDER BY releve.a;"
Set maBD = OpenDatabase(strConnection)
Set rst = maBD.OpenRecordset(monSQL)
leNbre = rst.RecordCount
If leNbre = 0 Then
MsgBox "Le ou les 1er chiffres du code" & vbLf _
& "que vous avez introduit" & vbLf _
& "n'existe pas dans la base de données." & vbLf & vbLf _
& "Vous pouvez re-formuler votre demande.", vbCritical, "Erreur codes"
TXTcode = ""
TXTcode.SetFocus
Lstview1.ListItems.Clear
Exit Sub
End If
Lstview1.ListItems.Clear
Set ObjListe = Lstview1.ListItems.Add(, , rst!a) ' 1ere colonne
ObjListe.SubItems(1) = IIf(IsNull(rst!mtg.Value), "", rst!b.Value) ' 2eme colonne
ObjListe.SubItems(2) = "" & (rst!c.Value) '3éme colonne
ObjListe.SubItems(3) = "" & (rst!d.Value) '4éme colonne
ObjListe.SubItems(4) = "" & (rst!e.Value) '5éme colonne
ObjListe.SubItems(5) = "" & (rst!f.Value) '6éme colonne
ObjListe.SubItems(6) = "" & (rst!g.Value) '7éme colonne
ObjListe.SubItems(7) = "" & (rst!h.Value) '8éme colonne
ObjListe.SubItems(8) = "" & (rst!i.Value) '9éme colonne
ObjListe.SubItems(9) = "" & (rst!j.Value) '10éme colonne
ObjListe.SubItems(10) = "" & (rst!k.Value) '11éme colonne
ObjListe.SubItems(11) = "" & (rst!l.Value) '12éme colonne
ObjListe.SubItems(12) = "" & (rst!m.Value) '13éme colonne
Lstview1.FullRowSelect = True
Lstview1.View = lvwReport
If rst.RecordCount > 0 Then
rst.MoveFirst
Do While Not rst.EOF ' Set ObjListe Nothing
Set ObjListe = Lstview1.ListItems.Add(, , rst!a) ' 1ere colonne
ObjListe.SubItems(1) = IIf(IsNull(rst!mtg.Value), "", rst!b.Value) ' 2eme colonne
ObjListe.SubItems(2) = "" & (rst!c.Value) '3éme colonne
ObjListe.SubItems(3) = "" & (rst!d.Value) '4éme colonne
ObjListe.SubItems(4) = "" & (rst!e.Value) '5éme colonne
ObjListe.SubItems(5) = "" & (rst!f.Value) '6éme colonne
ObjListe.SubItems(6) = "" & (rst!g.Value) '7éme colonne
ObjListe.SubItems(7) = "" & (rst!h.Value) '8éme colonne
ObjListe.SubItems(8) = "" & (rst!i.Value) '9éme colonne
ObjListe.SubItems(9) = "" & (rst!j.Value) '10éme colonne
ObjListe.SubItems(10) = "" & (rst!k.Value) '11éme colonne
ObjListe.SubItems(11) = "" & (rst!l.Value) '12éme colonne
ObjListe.SubItems(12) = "" & (rst!m.Value) '13éme colonne
'==============================
rst.MoveNext
Loop
End If
Set rst = Nothing
Set maBD = Nothing
End Sub
Private Sub Txtmtg_Change()
If Critère = "" Then
msg = MsgBox("Il faut renseigner le champ OP", vbCritical)
Exit Sub
End If
Critèrem = Txtmtg.Text & "*" 'ne pas oublier de mettre .Text
monSQL = "SELECT releve.a, releve.b, releve.c, releve.d, releve.e, releve.f, releve.g, releve.h, releve.i, releve.j, releve.k, releve.l, releve.m FROM releve " _
& "WHERE releve.a Like '" & Critère & "' And releve.b Like '" & Critèrem & "'" _
& "ORDER BY releve.b;"
Set maBD = OpenDatabase(strConnection)
Set rst = maBD.OpenRecordset(monSQL)
leNbre = rst.RecordCount
If leNbre = 0 Then
MsgBox "Le ou les 1er chiffres du code" & vbLf _
& "que vous avez introduit" & vbLf _
& "n'existe pas dans la base de données." & vbLf & vbLf _
& "Vous pouvez re-formuler votre demande.", vbCritical, "Erreur codes"
Txtmtg = ""
Txtmtg.SetFocus
Lstview1.ListItems.Clear
Exit Sub
End If
Lstview1.ListItems.Clear
Set ObjListe = Lstview1.ListItems.Add(, , rst!a) ' 1ere colonne
ObjListe.SubItems(1) = IIf(IsNull(rst!mtg.Value), "", rst!b.Value) ' 2eme colonne
ObjListe.SubItems(2) = "" & (rst!c.Value) '3éme colonne
ObjListe.SubItems(3) = "" & (rst!d.Value) '4éme colonne
ObjListe.SubItems(4) = "" & (rst!e.Value) '5éme colonne
ObjListe.SubItems(5) = "" & (rst!f.Value) '6éme colonne
ObjListe.SubItems(6) = "" & (rst!g.Value) '7éme colonne
ObjListe.SubItems(7) = "" & (rst!h.Value) '8éme colonne
ObjListe.SubItems(8) = "" & (rst!i.Value) '9éme colonne
ObjListe.SubItems(9) = "" & (rst!j.Value) '10éme colonne
ObjListe.SubItems(10) = "" & (rst!k.Value) '11éme colonne
ObjListe.SubItems(11) = "" & (rst!l.Value) '12éme colonne
ObjListe.SubItems(12) = "" & (rst!m.Value) '13éme colonne
Lstview1.FullRowSelect = True
Lstview1.View = lvwReport
If rst.RecordCount > 0 Then
rst.MoveFirst
Do While Not rst.EOF ' Set ObjListe Nothing
Set ObjListe = Lstview1.ListItems.Add(, , rst!a) ' 1ere colonne
ObjListe.SubItems(1) = IIf(IsNull(rst!mtg.Value), "", rst!b.Value) ' 2eme colonne
ObjListe.SubItems(2) = "" & (rst!c.Value) '3éme colonne
ObjListe.SubItems(3) = "" & (rst!d.Value) '4éme colonne
ObjListe.SubItems(4) = "" & (rst!e.Value) '5éme colonne
ObjListe.SubItems(5) = "" & (rst!f.Value) '6éme colonne
ObjListe.SubItems(6) = "" & (rst!g.Value) '7éme colonne
ObjListe.SubItems(7) = "" & (rst!h.Value) '8éme colonne
ObjListe.SubItems(8) = "" & (rst!i.Value) '9éme colonne
ObjListe.SubItems(9) = "" & (rst!j.Value) '10éme colonne
ObjListe.SubItems(10) = "" & (rst!k.Value) '11éme colonne
ObjListe.SubItems(11) = "" & (rst!l.Value) '12éme colonne
ObjListe.SubItems(12) = "" & (rst!m.Value) '13éme colonne
'==============================
rst.MoveNext
Loop
End If
Set rst = Nothing
Set maBD = Nothing
End Sub
jmfmarques
Messages postés7666Date d'inscriptionsamedi 5 novembre 2005StatutMembreDernière intervention22 août 201427 9 avril 2007 à 19:26
Quand chaibat (salut Chaibat) écrit :
scgridfree
clsdatagrid
unbound
le premier marche, les autres non...
et qu'il dit plus loin :
moi ça va très bien , merci
les autres ? je m' en tape...
Les choses sont apparemment claires pour tous, sauf pour toi, marcod59 Tu n'as pas compris qu'il "se tapait" de clsdatagrid et de unbound ?
Quand toi, par contre, tu écris tranquillement : je ne vois pas ce qu'il fait ici !!!, je ne peux m'empêcher de penser certaines choses (devine lesquelles).
Ce qui reste certain est que de Chaibat05, OUI, nous avons tous besoin ici ...
marcod59
Messages postés170Date d'inscriptionvendredi 16 janvier 2004StatutMembreDernière intervention13 juin 2010 9 avril 2007 à 23:17
Salut DARKSIDIOUS,
J'ai réussi à rentrer le code, j'ai encore un peu de problème avec la requête SQL, mais ça va venir.
Et je confirme bien que niveau rapidité, ça le fait.