[WD-2007] Optimisation exécution listview [Résolu]

[Dico_fou]

Bonjour à tous,

Etant nouveau sur ce forum je me présente rapidement: Je suis ingénieur en CVC et je tape du vba, pendant mon temps libre, depuis environ 8 mois. Je crée des petits programmes pour optimiser les procédures d'exécution au sein de mon entreprise. Pour l'instant, j'ai surtout fait des formulaires ou autres userform simples sur Word. Jusqu'à maintenant, je travaillé seul avec l'aide en ligne de visual basic, en cherchant sur msdn ou encore sur grâce au message déjà postés sur cet excellent forum avec une communauté incroyable. J'ai toujours trouvé une solution à mon problème en cherchant et je trouve cette méthode d'autant plus gratifiante.

Malheureusement aujourd'hui je coince sur un problème qui demande votre aide. En effet, j'ai mis au point un userform avec une listview permettant d'afficher une liste de contacts pompée depuis un dossier de contacts sur outlook. Je peux intégrer les différentes coordonnées du contact sélectionné dans des formfields définies dans le document.

Le problème se situe lors du changement du dossier de contacts par une combobox. Lors de l'initialisation de la fenêtre sur le dossier par défaut, aucun problème l'exécution se passe sans problème. Une fois que l'on modifie notre dossier dans la combobox, l'exécution prend alors un temps incroyable (au point de voir la listview se rafraichir avec l'ajout de chaque contact). Des bugs apparaissent également avec des lignes vides, certains contacts on juste le nom, des doublons...).

Faut-il plus le code lors de la boucle ? Comment puis-je optimiser le temps d'exécution ? Voici le code en question:

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
Option Explicit
 
Dim olApp As New Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olMyContact As Outlook.ContactItem
Dim olFolders As Outlook.Folder
Dim olDefContactFldr As Outlook.Folder
Dim bcmRootFldr As Outlook.Folder
Dim bcmContactFldr As Outlook.Folder
Dim objContact As ContactItem
 
 
Private Sub UserForm_Initialize()
 
'Instance des Objets
    Set olNS = olApp.GetNamespace("MAPI")
    Set olDefContactFldr = olNS.GetDefaultFolder _
                           (olFolderContacts)
    On Error Resume Next
    Set bcmRootFldr = olNS.Session.Folders _
                      ("Gestionnaire de contacts professionnels")
    On Error GoTo 0
    'Permet le choix entre les contacts personnels et le bcm
    With cboSessionList
        .Clear
        .AddItem (olDefContactFldr.Name)
        If bcmRootFldr Is Nothing Then
        Else
            .AddItem (bcmRootFldr.Name)
        End If
    End With
 
    cboSessionList.ListIndex = 0
 
    'Définit les entêtes de colonnes
    With lstContacts
        With .ColumnHeaders
            'Supprime les anciens entêtes
            .Clear
            'Ajout des colonnes
            .Add Text:="Nom", Width:=70
            .Add Text:="Prénom", Width:=70
            .Add Text:="Entreprise", Width:=80
            .Add Text:="E-mail", Width:=120
            .Add Text:="Tél bureau", Width:=80
            .Add Text:="Fax bureau", Width:=80
            .Add Text:="Tél mobile", Width:=80
            .Add Text:="Rue", Width:=90
            .Add Text:="CP", Width:=30
            .Add Text:="Ville", Width:=50
            .Add Text:="Catégorie", Width:=70
        End With
 
        .View = lvwReport           'affichage en mode Rapport
        .GridLines = True           'affichage d'un quadrillage
        .FullRowSelect = True       'Sélection des lignes complètes
        .Sorted = True              'tri les contact selon la 1ère colonne
        .AllowColumnReorder = False    'ne permet pas de réorganiser les colonnes
    End With
 
    'La première ligne étant toujours séléctionnée par défaut,
    'on la déséléctionne par l'instruction suivante
    Set lstContacts.SelectedItem = Nothing
    Set olFolders = Nothing
    Set olApp = Nothing
    Set olNS = Nothing
End Sub
 
Private Sub cboSessionList_Change()
 
    Dim objChosenFldr As Object
    Dim i As Integer
 
    If cboSessionList = olDefContactFldr.Name Then
        Set objChosenFldr = olDefContactFldr.Items
    ElseIf cboSessionList = bcmRootFldr.Name Then
        Set objChosenFldr = bcmRootFldr.Folders("Contacts professionnels").Items
    End If
    'purge de la liste
    lstContacts.ListItems.Clear
 
    For Each objContact In objChosenFldr
        i = i + 1
 
        With lstContacts
            .ListItems.Add Text:=objContact.LastName
            .ListItems(i).ListSubItems.Add Text:=objContact.FirstName
            .ListItems(i).ListSubItems.Add Text:=objContact.CompanyName
            .ListItems(i).ListSubItems.Add Text:=objContact.Email1Address
            .ListItems(i).ListSubItems.Add Text:=objContact.BusinessTelephoneNumber
            .ListItems(i).ListSubItems.Add Text:=objContact.BusinessFaxNumber
            .ListItems(i).ListSubItems.Add Text:=objContact.MobileTelephoneNumber
            .ListItems(i).ListSubItems.Add Text:=objContact.BusinessAddressStreet
            .ListItems(i).ListSubItems.Add Text:=objContact.BusinessAddressPostalCode
            .ListItems(i).ListSubItems.Add Text:=objContact.BusinessAddressCity
            .ListItems(i).ListSubItems.Add Text:=objContact.Categories
 
        End With
    Next objContact
 
Set objChosenFldr = Nothing
End Sub

Merci d'avance de votre patience.

[carden752]

Bonjour,

Dans

Code :

Private Sub cboSessionList_Change()

Tu déclares i et l'incrémentes mais ne l'initialises pas.

[Dico_fou]

Bonjour,

Merci. Erreur de débutant, impardonnable . J'ai initié l'Integer i, mais cela ne change rien à l'exécution de la macro . Le changement de carnet d'adresse prends plus de 10s lorsque l'initialisation de l'Userform ne prends que 2s!! En changeant la valeur de la combobox, j'ai des bugs qui apparaissent, chose qui ne se produit pas lors de l'initialisation. Peut-être un problème de domaine de déclaration... La méthode que j'utilise ne semble pas très élégante mais je n'en connais pas d'autres.

J'ai modifier quelque peu le code afin que ceux qui n'ont pas BCM puisse également le lancer pour ce rendre compte du problème. Le choix ce fait entre le dossier par défaut ("Contacts") et le prochain carnet d'adresse.

Attention! Le carnet d'adresse doit être crée dans le dossier "Mes contacts" sinon la macro plante ( il est en effet tout à fait possible de crée un carnet d'adresse contact dans le dossier boîte de réception par exemple...).

Voici le code et le fichier d'exemple pour les curieux. Merci de votre aide.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
Option Explicit
 
Dim olApp As New Outlook.Application
Dim olNS As Outlook.NameSpace
Dim olMyContact As Outlook.ContactItem
Dim olFolders As Outlook.Folder
Dim olDefContactFldr As Outlook.Folder
Dim Contact2Fldr As Outlook.Folder
Dim bcmContactFldr As Outlook.Folder
Dim objContact As ContactItem
 
 
Private Sub UserForm_Initialize()
 
'Instance des Objets
    Set olNS = olApp.GetNamespace("MAPI")
    Set olDefContactFldr = olNS.GetDefaultFolder(olFolderContacts)
    Set Contact2Fldr = olDefContactFldr.Folders(1)
    'Permet le choix entre les contacts personnels et le bcm
    With cboSessionList
        .Clear
        .AddItem (olDefContactFldr.Name)
        If Contact2Fldr Is Nothing Then
        Else
            .AddItem (Contact2Fldr.Name)
        End If
    End With
 
    cboSessionList.ListIndex = 0
 
    'Définit les entêtes de colonnes
    With lstContacts
        With .ColumnHeaders
            'Supprime les anciens entêtes
            .Clear
            'Ajout des colonnes
            .Add Text:="Nom", Width:=70
            .Add Text:="Prénom", Width:=70
            .Add Text:="Entreprise", Width:=80
            .Add Text:="E-mail", Width:=120
            .Add Text:="Tél bureau", Width:=80
 ...
            .Add Text:="Ville", Width:=50
            .Add Text:="Catégorie", Width:=70
        End With
 
        .View = lvwReport           'affichage en mode Rapport
        .GridLines = True           'affichage d'un quadrillage
        .FullRowSelect = True       'Sélection des lignes complètes
        .Sorted = True              'tri les contact selon la 1ère colonne
        .AllowColumnReorder = False    'ne permet pas de réorganiser les colonnes
    End With
 
    'La première ligne étant toujours séléctionnée par défaut,
    'on la déséléctionne par l'instruction suivante
    Set lstContacts.SelectedItem = Nothing
    Set olFolders = Nothing
    Set olApp = Nothing
    Set olNS = Nothing
End Sub
 
Private Sub cboSessionList_Change()
 
    Dim objChosenFldr As Object
    Dim i As Integer
 
    If cboSessionList = olDefContactFldr.Name Then
        Set objChosenFldr = olDefContactFldr.Items
    ElseIf cboSessionList = Contact2Fldr.Name Then
        Set objChosenFldr = Contact2Fldr.Items
    End If
    'purge de la liste
    lstContacts.ListItems.Clear
    i = 1
    For Each objContact In objChosenFldr
 
        With lstContacts
            .ListItems.Add Text:=objContact.LastName
            .ListItems(i).ListSubItems.Add Text:=objContact.FirstName
            .ListItems(i).ListSubItems.Add Text:=objContact.CompanyName
            .ListItems(i).ListSubItems.Add Text:=objContact.Email1Address
...
            .ListItems(i).ListSubItems.Add Text:=objContact.Categories
        End With
 
        i = i + 1
    Next objContact
 
    Set objChosenFldr = Nothing
End Sub

[Dico_fou]

Personne n'a une idée ?! Je pense également que mon post n'est pas placé dans la bonne section. Mais bon, un contrôle VB utiliser avec des méthodes VBA d'Outlook pour une macro dédiée à l'élaboration de formulaires dans Word... Ca fait un peu beaucoup.

[Dico_fou]

Salut tout le monde,

Après avoir repasser en vue tout mon code, j'ai débogué en partie celui-ci: Lors de l'initialisation de l'userform je change l'index de ma combobox en appliquant le dossier par défaut:

Code :

cboSessionList.ListIndex = 0

La chose que je ne savais pas, c'est que même lors de cette phase, ce changement lance l'événement cboSessionList_Change()!!! (normal sinon la listview ne serait pas remplie lors du lancement de l'userform...). Du coup, l'userform n'apparait que lorsque la boucle incluant les contacts est terminée. Après ça, j'ai utilisée la propriété Sorted de la listview pour trier selon la 1ère colonne.

Quant un changement intervient dans la combobox, la propriété Sorted est encore sur True ce qui donne une m**** pas possible lors de la boucle !!! Il faut donc s'assurer que la propriété SORTED est False lors d'ajout de données dans une listview. Maintenant, je n'ai plus de bugs lors du remplissage.

Cependant, vu que la listview est active lors du remplissage, cette dernière ce rafraichit à chaque nouveau contact. C'est plus rapide qu'avant, mais c'est pas encore ça (et toujours pas aussi rapide que lors de l'initialisation de la listview). Existe-il un moyen d'empêcher le rafraichissent de la listview avant que la boucle soit terminée? Je sais qu'en VB il y a la méthode AddRange. Y a t'il une méthode analogue en VBA ?


Merci de votre patiente

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
 Private Sub UserForm_Initialize()
 
'Instance des Objets
    Set olNS = olApp.GetNamespace("MAPI")
    Set olDefContactFldr = olNS.GetDefaultFolder _
                           (olFolderContacts)
    On Error Resume Next
    Set bcmRootFldr = olNS.Session.Folders _
                      ("Gestionnaire de contacts professionnels")
    On Error GoTo 0
    'Permet le choix entre les contacts personnels et le bcm
    With cboSessionList
        .Clear
        .AddItem (olDefContactFldr.Name)
        If bcmRootFldr Is Nothing Then
        Else
            .AddItem (bcmRootFldr.Name)
        End If
    End With
 
    cboSessionList.ListIndex = 0
 
    'Définit les entêtes de colonnes
    With lstContacts
        With .ColumnHeaders
            'Supprime les anciens entêtes
            .Clear
            'Ajout des colonnes
            .Add Text:="Nom", Width:=70
            .Add Text:="Prénom", Width:=70
            .Add Text:="Entreprise", Width:=80
            .Add Text:="E-mail", Width:=120
            .Add Text:="Tél bureau", Width:=80
            .Add Text:="Fax bureau", Width:=80
            .Add Text:="Tél mobile", Width:=80
            .Add Text:="Rue", Width:=90
            .Add Text:="CP", Width:=30
            .Add Text:="Ville", Width:=50
            .Add Text:="Catégorie", Width:=70
        End With
 
        .View = lvwReport           'affichage en mode Rapport
        .GridLines = True           'affichage d'un quadrillage
        .FullRowSelect = True       'Sélection des lignes complètes
        .Sorted = True              'tri les contact selon la 1ère colonne
        .AllowColumnReorder = False    'ne permet pas de réorganiser les colonnes
    End With
 
    'La première ligne étant toujours séléctionnée par défaut,
    'on la déséléctionne par l'instruction suivante
    Set lstContacts.SelectedItem = Nothing
    Set olFolders = Nothing
    Set olApp = Nothing
    Set olNS = Nothing
End Sub
 
Private Sub cboSessionList_Change()
 
    Dim objChosenFldr As Outlook.Items
    Dim i As Integer
 
    If cboSessionList = olDefContactFldr.Name Then
        Set objChosenFldr = olDefContactFldr.Items
    ElseIf cboSessionList = bcmRootFldr.Name Then
        Set objChosenFldr = bcmRootFldr.Folders("Contacts professionnels").Items
    End If
    'désactiver le tri avant l'ajout des contacts pour éviter les problèmes!!!
    lstContacts.Sorted = False
    'purge de la liste
    lstContacts.ListItems.Clear
    i = 1
    For Each objContact In objChosenFldr
        With lstContacts
            .ListItems.Add Text:=objContact.LastName
            .ListItems(i).ListSubItems.Add Text:=objContact.FirstName
            .ListItems(i).ListSubItems.Add Text:=objContact.CompanyName
            .ListItems(i).ListSubItems.Add Text:=objContact.Email1Address
            .ListItems(i).ListSubItems.Add Text:=objContact.BusinessTelephoneNumber
            .ListItems(i).ListSubItems.Add Text:=objContact.BusinessFaxNumber
            .ListItems(i).ListSubItems.Add Text:=objContact.MobileTelephoneNumber
            .ListItems(i).ListSubItems.Add Text:=objContact.BusinessAddressStreet
            .ListItems(i).ListSubItems.Add Text:=objContact.BusinessAddressPostalCode
            .ListItems(i).ListSubItems.Add Text:=objContact.BusinessAddressCity
            .ListItems(i).ListSubItems.Add Text:=objContact.Categories
        End With
        i = i + 1
    Next objContact
 
    lstContacts.Sorted = True
    Set objChosenFldr = Nothing
End Sub

[Dico_fou]

Voilà, j'ai trouvé une parade en utilisant l'option Visible de la listview. L'exécution est bien plus rapide en la rendant invisible. Cependant, en remettant listview.visible = true, le contrôle se place alors dans le coin supérieur gauche. J'ai essayé de capturé la position de la listview pour lui redonné son ancien emplacement mais sans succès.

Ma discussion étant posté au mauvais endroit, je vais en ouvrir une autre dans une autre section.