Optimisation remplissage listview en VBA

Salut à tous,

j'ai crée un userform avec une listview en VBA qui est remplie par une requête vers Outlook afin de récupérer les coordonnées de mes différents contacts. J'ai implanté également une combobox qui permet de choisir le dossier d'adresse voulu (je dispose de Business Contact Manager).

Le problème se situe lors du re-remplissage de la listview lors de l'événement Combobox_Change(). En effet, la listview se rafraîchit à chaque nouveau contact se qui ralentit considérablement l'exécution de cette requête.

Je voulais savoir s'il existe un moyen de suspendre se rafraichissement lors du remplissage ou d'utiliser un code plus adapté pour cette application (malheureusement il me semble pas qu'il existe de propriété genre addrange comme dans vb, mais bon je suis aussi un débutant).

J'ai trouvé une parade grâce à la propriété Visible de la listview: en rendant cette dernière invisible lors du remplissage les choses se passent beaucoup plus rapidement. Cependant, lorsque je la fait réapparaitre, celle-ci va se mettre dans le coin supérieur gauche de l'userform (top=0, left=0). J'ai essayé de réaffecter sa position mais sans succès (je précise que j'ai crée l'userform grâce aux outils graphiques). Je trouve de plus cette méthode peut élégante.

Merci de votre patience ainsi que de votre aide !!!

Voici le code:

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
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 = 1
 
    '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
    Dim x As Integer
    Dim y 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
 
 
 
    lstContacts.ListItems.Clear     'purge de la liste
    lstContacts.Sorted = False      'désactiver le tri avant l'ajout des contacts pour éviter les problèmes!!!
    lstContacts.Visible = False
    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.Visible = True
    Set objChosenFldr = Nothing
End Sub