DEMANDE AIDE OPTIMISATION CODE

[Résolu]
Signaler
Messages postés
70
Date d'inscription
mercredi 24 septembre 2003
Statut
Membre
Dernière intervention
20 mars 2007
-
Messages postés
15814
Date d'inscription
jeudi 8 août 2002
Statut
Modérateur
Dernière intervention
4 mars 2013
-
Bonjour,

Le code suivant fonctionne, mais le traitement est TRES LONG. Je demande de l'aide pour optimiser ce code. Merci a ceux qui vondront m'aider, j'ai du mal a l'optimiser.

Public Function liste()


Dim i, j As Integer


Set db = OpenDatabase(App.Path & "" & "datas.mdb")
Set rst = db.OpenRecordset("ADHERENTS")


PRINCIPAL.liste.Clear
PRINCIPAL.liste.Cols = 10
PRINCIPAL.liste.FixedCols = 0
PRINCIPAL.liste.FixedRows = 0
PRINCIPAL.liste.ColWidth(0) = 900
PRINCIPAL.liste.ColWidth(1) = 2000
PRINCIPAL.liste.ColWidth(2) = 2000
PRINCIPAL.liste.ColWidth(3) = 250
PRINCIPAL.liste.ColWidth(4) = 250
PRINCIPAL.liste.ColWidth(5) = 250
PRINCIPAL.liste.ColWidth(6) = 250
PRINCIPAL.liste.ColWidth(7) = 1000
PRINCIPAL.liste.ColWidth(8) = 1000
PRINCIPAL.liste.ColWidth(9) = 1000


With PRINCIPAL.liste
.TextMatrix(0, 0) = "Id"
.TextMatrix(0, 1) = "Nom"
.TextMatrix(0, 2) = "Prénom"
.TextMatrix(0, 3) = "?"
.TextMatrix(0, 4) = "C"
.TextMatrix(0, 5) = "E"
.TextMatrix(0, 6) = "P"
.TextMatrix(0, 7) = "Licence"
.TextMatrix(0, 8) = "Tel. Dom."
.TextMatrix(0, 9) = "Tel. GSM"
End With


rst.MoveFirst
Do Until rst.EOF
PRINCIPAL.liste.AddItem rst!numero & Chr(9) & rst!nom & Chr(9) & rst!prenom & Chr(9) & rst!cotisation & Chr(9) & rst!certificat & Chr(9) & rst!enveloppe & Chr(9) & rst!photo & Chr(9) & rst!licenceid & Chr(9) & rst!teldomicile & Chr(9) & rst!portable
rst.MoveNext
Loop


With PRINCIPAL.liste
For i = 1 To .Rows - 1
If .TextMatrix(i, 3) = "NON" Then
PRINCIPAL.liste.TextMatrix(i, 3) = ""
.Row = i
For j = 0 To .Cols - 1
.Col = j
PRINCIPAL.liste.Row = i
PRINCIPAL.liste.Col = 3
Set PRINCIPAL.liste.CellPicture = LoadPicture(App.Path & "" & "non.ico")
Next
End If
If .TextMatrix(i, 3) = "OUI" Then
PRINCIPAL.liste.TextMatrix(i, 3) = ""
.Row = i
For j = 0 To .Cols - 1
.Col = j
PRINCIPAL.liste.Row = i
PRINCIPAL.liste.Col = 3
Set PRINCIPAL.liste.CellPicture = LoadPicture(App.Path & "" & "oui.ico")
Next
End If
Next
End With


With PRINCIPAL.liste
For i = 1 To .Rows - 1
If .TextMatrix(i, 4) = "NON" Then
PRINCIPAL.liste.TextMatrix(i, 4) = ""
.Row = i
For j = 0 To .Cols - 1
.Col = j
PRINCIPAL.liste.Row = i
PRINCIPAL.liste.Col = 4
Set PRINCIPAL.liste.CellPicture = LoadPicture(App.Path & "" & "non.ico")
Next
End If
If .TextMatrix(i, 4) = "OUI" Then
PRINCIPAL.liste.TextMatrix(i, 4) = ""
.Row = i
For j = 0 To .Cols - 1
.Col = j
PRINCIPAL.liste.Row = i
PRINCIPAL.liste.Col = 4
Set PRINCIPAL.liste.CellPicture = LoadPicture(App.Path & "" & "oui.ico")
Next
End If
Next
End With


With PRINCIPAL.liste
For i = 1 To .Rows - 1
If .TextMatrix(i, 5) = "NON" Then
PRINCIPAL.liste.TextMatrix(i, 5) = ""
.Row = i
For j = 0 To .Cols - 1
.Col = j
PRINCIPAL.liste.Row = i
PRINCIPAL.liste.Col = 5
Set PRINCIPAL.liste.CellPicture = LoadPicture(App.Path & "" & "non.ico")
Next
End If
If .TextMatrix(i, 5) = "OUI" Then
PRINCIPAL.liste.TextMatrix(i, 5) = ""
.Row = i
For j = 0 To .Cols - 1
.Col = j
PRINCIPAL.liste.Row = i
PRINCIPAL.liste.Col = 5
Set PRINCIPAL.liste.CellPicture = LoadPicture(App.Path & "" & "oui.ico")
Next
End If
Next
End With


With PRINCIPAL.liste
For i = 1 To .Rows - 1
If .TextMatrix(i, 6) = "NON" Then
PRINCIPAL.liste.TextMatrix(i, 6) = ""
.Row = i
For j = 0 To .Cols - 1
.Col = j
PRINCIPAL.liste.Row = i
PRINCIPAL.liste.Col = 6
Set PRINCIPAL.liste.CellPicture = LoadPicture(App.Path & "" & "non.ico")
Next
End If
If .TextMatrix(i, 6) = "OUI" Then
PRINCIPAL.liste.TextMatrix(i, 6) = ""
.Row = i
For j = 0 To .Cols - 1
.Col = j
PRINCIPAL.liste.Row = i
PRINCIPAL.liste.Col = 6
Set PRINCIPAL.liste.CellPicture = LoadPicture(App.Path & "" & "oui.ico")
Next
End If
Next
End With


End Function

3 réponses

Messages postés
15814
Date d'inscription
jeudi 8 août 2002
Statut
Modérateur
Dernière intervention
4 mars 2013
125
Exact, pour corriger cà :


Dim sTexte as string


With PRINCIPAL.liste



For x = 4 To 6
.Col = x
For i = 1 To .Rows - 1
.Row = i
sTexte = .TextMatrix(i, x)
If sTexte = "NON" Then
.TextMatrix(i, x) = ""

Set .CellPicture = LoadPicture(App.Path & "" &
"non.ico")
ElseIf sTexte = "OUI" Then

.TextMatrix(i, x) = ""


Set .CellPicture = LoadPicture(App.Path & "" &
"oui.ico")
End If
Next i
Next x




End With


Et du coup, ca devrait aller encore plus vite !

_____________________________________________________________________
DarK Sidious

Un API Viewer (pour le VB, VB.NET, C, C# et Delphi) tout en français : www.ProgOtoP.com/popapi/
3
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

Codes Sources 70 internautes nous ont dit merci ce mois-ci

Messages postés
15814
Date d'inscription
jeudi 8 août 2002
Statut
Modérateur
Dernière intervention
4 mars 2013
125
Ben tout dépend du nombre de ligne de ton grid aussi...



Une des premières chose à faire : bloquer le raffraichissement du
contrôle (en le rendant invisible par exemple), cela évite de le
retracer à chaque modification (tu devrais y gagner de précieuses
secondes).



Ensuite, niveau code, tu peux optimiser un peu avec 2 boucles imbriquées :



With PRINCIPAL.liste
For i = 1 To .Rows - 1
If .TextMatrix(i, 3) = "NON" Then
PRINCIPAL.liste.TextMatrix(i, 3) = ""
.Row = i
For j = 0 To .Cols - 1
.Col = j
PRINCIPAL.liste.Row = i
PRINCIPAL.liste.Col = 3

Set PRINCIPAL.liste.CellPicture = LoadPicture(App.Path & "" &
"non.ico")
Next
End If
If .TextMatrix(i, 3) = "OUI" Then
PRINCIPAL.liste.TextMatrix(i, 3) = ""
.Row = i
For j = 0 To .Cols - 1
.Col = j

PRINCIPAL.liste.Row = i

PRINCIPAL.liste.Col = 3

Set PRINCIPAL.liste.CellPicture = LoadPicture(App.Path & "" &
"oui.ico")
Next
End If
Next
End With



With PRINCIPAL.liste
For i = 1 To .Rows - 1
If .TextMatrix(i, 4) = "NON" Then
PRINCIPAL.liste.TextMatrix(i, 4) = ""
.Row = i
For j = 0 To .Cols - 1
.Col = j
PRINCIPAL.liste.Row = i
PRINCIPAL.liste.Col = 4

Set PRINCIPAL.liste.CellPicture = LoadPicture(App.Path & "" &
"non.ico")
Next
End If
If .TextMatrix(i, 4) = "OUI" Then
PRINCIPAL.liste.TextMatrix(i, 4) = ""
.Row = i
For j = 0 To .Cols - 1
.Col = j

PRINCIPAL.liste.Row = i

PRINCIPAL.liste.Col = 4

Set PRINCIPAL.liste.CellPicture = LoadPicture(App.Path & "" &
"oui.ico")
Next
End If
Next
End With



With PRINCIPAL.liste
For i = 1 To .Rows - 1
If .TextMatrix(i, 5) = "NON" Then
PRINCIPAL.liste.TextMatrix(i, 5) = ""
.Row = i
For j = 0 To .Cols - 1
.Col = j
PRINCIPAL.liste.Row = i
PRINCIPAL.liste.Col = 5

Set PRINCIPAL.liste.CellPicture = LoadPicture(App.Path & "" &
"non.ico")
Next
End If
If .TextMatrix(i, 5) = "OUI" Then
PRINCIPAL.liste.TextMatrix(i, 5) = ""
.Row = i
For j = 0 To .Cols - 1
.Col = j

PRINCIPAL.liste.Row = i

PRINCIPAL.liste.Col = 5

Set PRINCIPAL.liste.CellPicture = LoadPicture(App.Path & "" &
"oui.ico")
Next
End If
Next
End With



With PRINCIPAL.liste
For i = 1 To .Rows - 1
If .TextMatrix(i, 6) = "NON" Then
PRINCIPAL.liste.TextMatrix(i, 6) = ""
.Row = i
For j = 0 To .Cols - 1
.Col = j
PRINCIPAL.liste.Row = i
PRINCIPAL.liste.Col = 6

Set PRINCIPAL.liste.CellPicture = LoadPicture(App.Path & "" &
"non.ico")
Next
End If
If .TextMatrix(i, 6) = "OUI" Then
PRINCIPAL.liste.TextMatrix(i, 6) = ""
.Row = i
For j = 0 To .Cols - 1
.Col = j

PRINCIPAL.liste.Row = i

PRINCIPAL.liste.Col = 6

Set PRINCIPAL.liste.CellPicture = LoadPicture(App.Path & "" &
"oui.ico")
Next
End If
Next
End With



devient alors :

Dim sTexte as string



With PRINCIPAL.liste


For x = 4 To 6

PRINCIPAL.liste.Col = x

For i = 1 To .Rows - 1

.Row = i

sTexte = .TextMatrix(i, x)

If sTexte = "NON" Then

PRINCIPAL.liste.TextMatrix(i, x) = ""
For j = 0 To .Cols - 1
.Col = j

Set PRINCIPAL.liste.CellPicture = LoadPicture(App.Path & "" &
"non.ico")
Next j
ElseIf sTexte = "OUI" Then


PRINCIPAL.liste.TextMatrix(i, x) = ""


For j = 0 To .Cols - 1


.Col = j


Set PRINCIPAL.liste.CellPicture = LoadPicture(App.Path & "" &
"oui.ico")
Next j
End If
Next i

Next x




End With




_____________________________________________________________________
DarK Sidious

Un API Viewer (pour le VB, VB.NET, C, C# et Delphi) tout en français : www.ProgOtoP.com/popapi/
Messages postés
70
Date d'inscription
mercredi 24 septembre 2003
Statut
Membre
Dernière intervention
20 mars 2007
1
Salut DarK Sidious

Merci pour cette réponse rapide.
Le code est bcp plus rapide à l'exécution mais la boule verte ou rouge (c est ce que represente les 2 fichiers icones) s'affichent dans toutes les colonnes au lieu seulement des colonne indexees 4 à 6.