liste personnalisée (custom list) et rafraichissement

**zert84** · 13/08/2008, 18h37

Bonjour,

dans une macro vba, mon code ajoute une liste personnalisée pour pouvoir ensuite l'utiliser pour effectuer des tris.
Mon problème vient du fait que lorsque je lance ma macro, la liste est bien créée et on peut la retrouver dans "outils-option-liste pers.", sauf que le tri ne s'effectue pas.
si je lance la même macro une seconde fois le tri est effectué. Serait-ce un problème de "rafraichissement" le fait qu'excel ne prenne en compte cette liste personnalisée que lorsqu'on lance la macro une seconde fois?

je vous remercie d'avance pour vos idées et éclaircissements.

**zazaraignée** · 13/08/2008, 20h01

Ben tiens! sans voir le code de la macro... Hum!

Au fait bienvenue sur le forum (suite du message par MP)

**zert84** · 13/08/2008, 20h39

Merci zazaraignée pour ton accueil,

je mets donc en ligne le code de la macro qui plante (voir fin du message). le sub en question est appelé dans un autre sub que je n'ai pas mis en ligne.

le problème vient de l'utilisation de la liste produite par:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Application.AddCustomList ListArray:=Array(liste)
                  m = Application.GetCustomListNum(Array(liste())) + 1

ce bout de code fonctionne, car je retrouve bien la liste personnalisée créée. c'est l'execution du bout de code suivant qui semble ne pas se réaliser. pas de message d'erreur mais le tri ne s'effectue que lors d'un deuxième lancement de la macro.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
 ActiveSheet.Select
       Range(cellule).Select
       Selection.Sort Order1:=xlAscending, Type:=xlSortLabels, OrderCustom:=m, _
        Orientation:=xlTopToBottom

l'objectif de ce tri est de trier des "items" présents dans un TCD.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
Sub TCD(Nom As String, a As Single, Site As String, Station As String, ind As Integer)
 
Worksheets("Travail2").Cells.Clear
Worksheets("Travail3").Cells.Clear
Worksheets("Travail5").Cells.Clear
Worksheets("Travail6").Cells.Clear
 
'Activation de la feuille contenant la plage de données
Sheets("BD").Activate
 
'dimension de la plage contenant les données
Dim DataR As Long
Dim DataC As Integer
Dim Source As String
 
'Selection de la plage de données
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
 
'Définition de la plage de données source pour le TCD
DataR = Selection.CurrentRegion.Rows.count
DataC = Selection.CurrentRegion.Columns.count
Source = "bd!R1C1:R" & CStr(DataR) & "C" & CStr(DataC)
'If i = 1 Then
'Selection de la feuille et de la cellule de départ pour la création du TCD
If a = 0 Then
   Sheets("Travail").Activate
   Range("A1").Select
End If
 
If a = 1 Then
   Sheets("Travailbis").Activate
   Range("A1").Select
End If
 
If a = 2 Then
   Sheets("Travailter").Activate
   Range("A1").Select
End If
 
 
If ind = 1 Then
 
'Création du TCD
   ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
    Source).CreatePivotTable TableDestination:=Selection, TableName:=Nom
 
   ActiveSheet.PivotTables(Nom).SmallGrid = False
 
'TCD pour la palette végétale
 
    If a = 0 Then
       ActiveSheet.PivotTables(Nom).RowGrand = True
       ActiveSheet.PivotTables(Nom).AddFields RowFields:= _
        Array("Type", "Essence", "Nom botanique"), PageFields:=Array("Site", "Station")
       ActiveSheet.PivotTables(Nom).PivotFields("Essence"). _
        Orientation = xlDataField
 
          'Suppression des sous-totaux inutiles
        ActiveSheet.PivotTables(Nom).PivotSelect _
        "Essence[All;Total]", xlDataAndLabel, True
        Selection.Delete
        'ActiveSheet.PivotTables(Nom).PivotFields("Site").CurrentPage = Site
    'ActiveSheet.PivotTables(Nom).PivotFields("Station").CurrentPage = Station
 
        'TCD pour les travaux
 
    ElseIf a = 1 Then
        ActiveSheet.PivotTables(Nom).RowGrand = True
        ActiveSheet.PivotTables(Nom).AddFields RowFields:= _
        Array("Type de travaux", "Travaux"), ColumnFields:="Urgence", PageFields:=Array("Site", "Station")
        ActiveSheet.PivotTables(Nom).PivotFields("Travaux"). _
        Orientation = xlDataField
 
         With ActiveSheet.PivotTables(Nom).PivotFields("Type de travaux")
           For i = 1 To .PivotItems.count
             If UCase(.PivotItems(i).Name) = UCase("(vide)") Then
                .PivotItems(i).Visible = False
             End If
           Next i
         End With
 
        With ActiveSheet.PivotTables(Nom).PivotFields("Travaux")
          For i = 1 To .PivotItems.count
            If UCase(.PivotItems(i).Name) = UCase("(vide)") Then
               .PivotItems(i).Visible = False
            End If
          Next i
        End With
 
 
        With ActiveSheet.PivotTables(Nom).PivotFields("Urgence")
          For i = 1 To .PivotItems.count
            If UCase(.PivotItems(i).Name) = UCase("(vide)") Then
               .PivotItems(i).Visible = False
            End If
          Next i
        End With
 
 
         ActiveSheet.PivotTables(Nom).PivotFields("Urgence"). _
        ShowAllItems = True
 
    ElseIf a = 2 Then
        ActiveSheet.PivotTables(Nom).RowGrand = True
        ActiveSheet.PivotTables(Nom).AddFields RowFields:= _
        Array("Site", "Station")
        ActiveSheet.PivotTables(Nom).PivotFields("Station"). _
        Orientation = xlDataField
                ActiveSheet.PivotTables(Nom).PivotSelect _
        "Site[All;Total]", xlDataAndLabel, True
        Selection.Delete
    End If
End If
 
 
If a = 0 Or a = 1 Then
    ActiveSheet.PivotTables(Nom).PivotFields("Site").CurrentPage = Site
    ActiveSheet.PivotTables(Nom).PivotFields("Station").CurrentPage = Station
End If
 
If ind = 1 Then
    If a = 1 Then
    Application.AddCustomList ListArray:=Array("port libre", "port pseudo libre", "port architecturé", "port réduit", "abattage", "essouchage", "recépage", "dévitalisation")
    n = Application.GetCustomListNum(Array("port libre", "port pseudo libre", "port architecturé", "port réduit", "abattage", "essouchage", "recépage", "dévitalisation")) + 1
'1 added to give true position of desired order in custom list
ActiveSheet.Select
Range("A5").Select
Selection.Sort Order1:=xlAscending, Header:=xlGuess, _
Type:=xlSortLabels, OrderCustom:=n, Orientation:=xlTopToBottom
 
 
 
   v = 6
   For t = 0 To 7
     texte = Worksheets("Tableaux").Cells(96, 11 + t).Text
     u = 0
     x = 1
     While Not IsEmpty(Worksheets("Tableaux").Cells(96 + x, 11 + t))
         u = u + 1
         x = x + 1
     Wend
 
     If Not u = 0 Then
        Dim liste() As Variant
        ReDim Preserve liste(u - 1)   
'(-1) car les arrays commencent à 0 et pas 1
      'remplir l'array
        For i = 0 To (u - 1)
           liste(i) = Sheets("Tableaux").Cells(97 + i, 11 + t).Value
        Next i
 
 
          Application.AddCustomList ListArray:=Array(liste)
                  m = Application.GetCustomListNum(Array(liste())) + 1
 
       MsgBox m
        Sheets("Travail").Activate
 
        w = v + u - 1
 
        cellule = b & v & ":" & b & w
        Range(cellule).Select
        v = w + 2
 
 
 
 
 
 
       ActiveSheet.Select
       Range(cellule).Select
       Selection.Sort Order1:=xlAscending, Type:=xlSortLabels, OrderCustom:=m, _
        Orientation:=xlTopToBottom
     End If
   Next
 
 
    End If
    End If
 
 If a = 0 Then
'Sélection du TCD nettoyé et collage sur Travail2
Worksheets("Travail").Activate
Range("A4").Select
  Selection.CurrentRegion.Select
  Selection.Copy
  Sheets("Travail2").Select
 Range("B2").Select
ActiveSheet.Paste
End If
 If a = 1 Then
'Sélection du TCD nettoyé et collage sur Travail3
Worksheets("Travailbis").Activate
Range("A4").Select
  Selection.CurrentRegion.Select
  Selection.Copy
  Sheets("Travail3").Select
 Range("B2").Select
ActiveSheet.Paste
End If
  If a = 0 Or a = 1 Then
'La première ligne inutile du TCD est éliminée
  Rows(2).Select
    Selection.Delete Shift:=xlUp
    Selection.CurrentRegion.Select
li = Selection.CurrentRegion.Rows.count
co = Selection.CurrentRegion.Columns.count
 
Set plage = Range(Cells(2, "B"), Cells(li, co))
End If
 
If a = 2 Then
'Sélection du TCD nettoyé et collage sur Travail2
Worksheets("Travailter").Activate
Selection.CurrentRegion.Select
li = Selection.CurrentRegion.Rows.count
co = Selection.CurrentRegion.Columns.count
 Range(Cells(3, "A"), Cells(li, co)).Select
Selection.Copy
 
 
 Sheets("Travail4").Activate
 Range("A1").Select
ActiveSheet.Paste
 
 
 
'Les deux premières lignes inutiles du TCD sont éliminées
Selection.CurrentRegion.Select
li = Selection.CurrentRegion.Rows.count
co = Selection.CurrentRegion.Columns.count
Rows(li).Select
    Selection.Delete Shift:=xlUp
    Columns(co).Select
    Selection.Delete Shift:=xlLeft
    Selection.CurrentRegion.Select
li = Selection.CurrentRegion.Rows.count
co = Selection.CurrentRegion.Columns.count
'Set TCD = Range(Cells(1, "A"), Cells(li, co))
 
  Set plage = Range(Cells(1, "A"), Cells(li, co))
End If
 
 
End Sub

merci d'avance pour vos réponses.

liste personnalisée (custom list) et rafraichissement

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager