[XL-2007] Question sur les tris est les sous-totaux

[Runsh63]

Bonjour,

J'utilise dans une macro pour la première les tris des données et les sous-totaux. Je suis parti de l'enregistreur qui m'a donné ceci :

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
Sub Macro2()
'
' Macro2 Macro
'
 
'
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveWorkbook.Worksheets("Detail local accounts").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Detail local accounts").Sort.SortFields.Add Key:= _
        Range("A2:A54"), SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder _
        := _
        "SALARY EXPENSES,CAR AND TRAVEL EXPENSES,TELECOMMUNICATIONS,MARKETING,VARIETIES REGISTRATION FEES,OTHER EXPENSES,OTHER INCOME,DEPRECIATION ON ASSETS" _
        , DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Detail local accounts").Sort
        .SetRange Range("A1:E54")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5), _
        Replace:=False, PageBreaks:=False, SummaryBelowData:=True
    Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(5), _
        Replace:=False, PageBreaks:=False, SummaryBelowData:=True
End Sub

J'ai tenté de l'alléger en l'écrivant ainsi :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Mon_test()
 
Dim LR1 As Long
 
    With Sheets("Detail local accounts")
 
    LR1 = .Range("A" & .Rows.Count).End(xlUp).Row
 
    'Trier données et inclure sous-totaux
 
        .Range("A1:A" & LR1).Sort , SortOn:=xlSortOnValues, Order:=xlAscending, CustomOrder:="SALARY EXPENSES,CAR AND TRAVEL EXPENSES,TELECOMMUNICATIONS,MARKETING,VARIETIES REGISTRATION FEES,OTHER EXPENSES,OTHER INCOME,DEPRECIATION ON ASSETS"
        .Range("A1:E" & LR1).Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5), Replace:=True, PageBreaks:=False, SummaryBelowData:=True
        .Range("A1:E" & LR1).Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(5), Replace:=False, PageBreaks:=False, SummaryBelowData:=True
 
End Sub

Bien entendu, ça bloque sur la première ligne en-dessous du commentaire avec le message d'erreur suivant : Application-defined or Object-defined error.

Pouvez-vous m'aider à résoudre mon problème SVP ? Une deuxième question suivra.
Je vous remercie grandement par avance !

[U. Milité]

Bonjour,

En consultant l'aide (je ne fais pas de tris sur base de listes personnalisées tous les jours ... et en imaginant que c'est bien de cela qu'il est question ) ... Je lis que le paramètre CustomOrder est un nombre entier, correspondant à la position de ta liste perso, dans l'ensemble des listes perso. Je viens de tester sous Excel2007 et ça semble fonctionner!

... à voir!

[Runsh63]

Bonjour,

Merci pour ta réponse, tu avais bien saisi le problème.
J'ai donc écrit de trois façons différentes sachant que cette liste est la seule liste personnalisé que j'ai mais rien à faire, il m'affiche le même message d'erreur. Au pire je reste avec la version enregistreur...

[U. Milité]

Bonsoir,

Pour info (si tu repasses par ici), cette version expurgée de ton code initial tourne sous Excel2007 ... Trie les enregistrements sur la colonne A en fonction de la liste personnalisée (qui est la dixième, sur ma machine) puis affiche les sous-totaux pour les montants qui figurent en colonne B

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub Macro2()
'
' Macro2 Macro
'
 
With ActiveWorkbook.Worksheets("Detail local accounts").Range("A2").CurrentRegion
    .Sort Key1:=Worksheets("Detail local accounts").Range("A2"), _
        Order1:=xlAscending, orderCustom:=10, Header:=xlYes
    .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
        Replace:=False, PageBreaks:=False, SummaryBelowData:=True
    '.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(5), _
    '   Replace:=False, PageBreaks:=False, SummaryBelowData:=True
End With
End Sub