Utilisation de la Fonction sous-total dans une macro

Version imprimable

Bonjour,

Je souhaite créer une macro qui me récupère des données d'une extraction.
J'ai jusque la réussi à automatiser le lancement de l'application pour effectuer l'extraction, filtrer les données que je veux.

Et c'est la que se pose mon problème, j'aimerais utiliser la fonction sous-total pour faire la somme d'une colonne pour ne prendre en compte que les cellules qui m'intéresse.
Cependant je n'y arrive pas.
voici mon code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Dim i As Integer, somme As Integer
Dim LR As Long


Shell "C:\Temp\BN_LanceMesSql.exe" 'ouvrir appli extraction automatique
Application.Wait Now + TimeValue("0:01:00") 'attente de 35secondes pour faire l'extraction


Set xlApp = GetObject("Classeur2").Application ' Récupère le nom de l'object Classeur2
            xlApp.Application.Workbooks("Classeur2").Sheets(1).Activate    ' Selectionne la feuille 1 du classeur2
            xlApp.Application.WindowState = xlMaximized  ' Mettre plein écran

xlApp.Application.Workbooks("Classeur2").Sheets(1).Range("A1:I1").Select
    xlApp.Application.Workbooks("Classeur2").Sheets(1).Range("A1:I1").AutoFilter
    xlApp.Application.Workbooks("Classeur2").Sheets(1).Range("A:I").AutoFilter Field:=4, Criteria1:="10114102"
    xlApp.Application.Workbooks("Classeur2").Sheets(1).Range("A:I").AutoFilter Field:=2, Criteria1:="20606"  'Filtre sur article et poste
    'somme = (xlApp.Application.Workbooks("Classeur2").WorksheetFunction.Subtotal(109, xlApp.Application.Workbooks("Classeur2").Sheets(1).Range("I2:I100")))
    
    xlApp.Application.Workbooks("Classeur2").Sheets(1).Range("I2:I600").Select
    xlApp.Application.Workbooks("Classeur2").Sheets(1).Range("I2:I600").NumberFormat = "0"
   
    somme = WorksheetFunction.Subtotal(109, xlApp.Application.Workbooks("Classeur2").Sheets(1).Range("I2:I600"))

Je suis ouverte à toutes propositions pouvant m'aider..

Par avance merci!

03/08/2018, 15h26
Jean-Philippe André

Salut,

l'ordre d'appel est le suivant :

Code:

Application.WorksheetFunction.Subtotal(tesparametres)

tu devrais pouvoir adapter aisément ton code :)

Bonjour,

Une piste et comme je présume que le code est exécuté depuis un module standard du classeur "Classeur2.xlsm", pas besoin d'utiliser l'objet "Application" :

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
 
 
    Dim Fe As Worksheet
    Dim Somme As Double
    Dim Lig As Long
    Dim I As Long
 
    Shell "C:\Temp\BN_LanceMesSql.exe" 'ouvrir appli extraction automatique
    Application.Wait Now + TimeValue("0:01:00") 'attente de 35secondes pour faire l'extraction
 
    Workbooks("Classeur2.xlsm").Application.WindowState = xlMaximized  ' Mettre plein écran
 
    Set Fe = Workbooks("Classeur2.xlsm").Sheets(1)
 
    With Fe
 
        'filtrage successifs
        .Range("A:I").AutoFilter
        .Range("A:I").AutoFilter 4, "10114102"
        .Range("A:I").AutoFilter 2, "20606"
 
        Lig = .Cells(.Rows.Count, 4).End(xlUp).Row
 
        'commence la boucle à 2 pour éviter les entêtes (à adapter !)
        'ne prend en compte que les cellules visibles de la colonne F et les additionne (à adapter !)
        For I = 2 To Lig
            If .Cells(I, 6).EntireRow.Hidden = False Then Somme = Somme + .Cells(I, 6).Value
        Next I
 
        'suppression du filtrage
        .Range("A:I").AutoFilter
 
    End With
 
    'affiche
    MsgBox Somme
 
End Sub

Après, si tu tiens vraiment à utiliser la fonction Sous.Total(), regardes du coté de l'objet Range d'AutoFilter !

06/08/2018, 13h18
manoon03

Citation:

Envoyé par Jean-Philippe André

Salut,

l'ordre d'appel est le suivant :

Code:

Application.WorksheetFunction.Subtotal(tesparametres)

tu devrais pouvoir adapter aisément ton code :)

Salut,

D'abord merci pour ta réponse, mais lorsque je mets ta partie de code, j'ai une erreur me disant qu'il y a une incompatibilité de type.

Peux-tu m'aider ?

Citation:
Envoyé par Theze
Bonjour,

Une piste et comme je présume que le code est exécuté depuis un module standard du classeur "Classeur2.xlsm", pas besoin d'utiliser l'objet "Application" :
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 Dim Fe As Worksheet Dim Somme As Double Dim Lig As Long Dim I As Long Shell "C:\Temp\BN_LanceMesSql.exe" 'ouvrir appli extraction automatique Application.Wait Now + TimeValue("0:01:00") 'attente de 35secondes pour faire l'extraction Workbooks("Classeur2.xlsm").Application.WindowState = xlMaximized ' Mettre plein écran Set Fe = Workbooks("Classeur2.xlsm").Sheets(1) With Fe 'filtrage successifs .Range("A:I").AutoFilter .Range("A:I").AutoFilter 4, "10114102" .Range("A:I").AutoFilter 2, "20606" Lig = .Cells(.Rows.Count, 4).End(xlUp).Row 'commence la boucle à 2 pour éviter les entêtes (à adapter !) 'ne prend en compte que les cellules visibles de la colonne F et les additionne (à adapter !) For I = 2 To Lig If .Cells(I, 6).EntireRow.Hidden = False Then Somme = Somme + .Cells(I, 6).Value Next I 'suppression du filtrage .Range("A:I").AutoFilter End With 'affiche MsgBox Somme End Sub
Après, si tu tiens vraiment à utiliser la fonction Sous.Total(), regardes du coté de l'objet Range d'AutoFilter !
Bonjour,

La macro est sur un premier fichier et j'ai une application SQL qui ouvre une extraction sous Excel, mais le fichier que l'application SQL ouvre n'est pas enregistré dans l'ordinateur, je n'ai donc pas le chemin du fichier.
C'est pour ça que je met application, ca ne fonctionnait pas sinon.

Ta piste peut- elle toujours marché meme avec l'utilisation de application ?

Merci.

Bonjour,

Testes ceci pour voir :

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
 
Sub Test()
 
    Dim xlApp As Object
    Dim Fe As Object
    Dim I As Long
    Dim Somme As Double
 
    Shell "C:\Temp\BN_LanceMesSql.exe" 'ouvrir appli extraction automatique
    Application.Wait Now + TimeValue("0:01:00") 'attente de 35secondes pour faire l'extraction
 
    Set xlApp = GetObject("Classeur2.xlsx").Application '<--- ajouter l'extension
 
    .WindowState = xlMaximized  ' Mettre plein écran
 
    Set Fe = xlApp.Workbooks("Classeur2.xlsx").Worksheets(1) '<--- ajouter l'extension
 
    With Fe
 
        .Range("A:I").AutoFilter
        .Range("A:I").AutoFilter 4, "10114102"
        .Range("A:I").AutoFilter 2, "20606"    'Filtre sur article et poste
 
        .Range("I2:I600").NumberFormat = "0"
 
        Lig = .Cells(.Rows.Count, 4).End(xlUp).Row
 
        For I = 2 To Lig
            If .Cells(I, 6).EntireRow.Hidden = False Then Somme = Somme + .Cells(I, 6).Value
        Next I
 
        'suppression du filtrage
        .Range("A:I").AutoFilter
 
    End With
 
    MsgBox Somme
 
End Sub

07/08/2018, 08h20
manoon03

Bonjour,

La macro que tu m'as donné ne met pas d'erreur, mais je ne trouve pas le bon résultat, peux-tu me dire à quel endroit dans le code on paramètre la colonne de la somme stp ?

Merci beaucoup pour ta réponse !
07/08/2018, 10h14
manoon03

J'ai trouvé le problème, ta solution fonctionne ! merci beaucoup ! tu me sauves !:D
07/08/2018, 10h42
Pierre Fauconnier

2 pièce(s) jointe(s)

Salut.

Pour répondre au problème posé (utilisation de Sous.Total dans une macro)…

Si tu t'appuies sur un tableau structuré, c'est hyper simple…

Code:

application.subtotal(109,range("tableau1[valeur]"))

Pièce jointe 402171

Pièce jointe 402172