Discussion :

[Scregneugneu]

Bonjour à tous,

Fervent utilisateur (à mon humble échelle) des échanges sur ce forum, je me permets à mon tour, comme tant d'autres avant moi d'ailleurs d'apporter ma pierre à l'édifice sur laquelle j'espère vous m'aiderez à construire une maison. Effectivement, chose rare, je n'ai malheureusement pas trouvé de réponse à ma question sur le Forum (peut-être ais-je mal aiguillé ma recherche, au quel cas j'en suis sûr, vous saurez me montrer la voie).

Je cherche actuellement à manipuler des segments de manière itérative sur plusieurs fichiers Excel présents dans un dossier. Chaque fichier est indexé sur une base Access et présente de nombreux onglets avec différents graphiques et tableaux croisés. Afin de fluidifier mon travail et de le personnaliser, j'ai créé sur chacun des fichiers un segment qui me permet de modifier sur chaque fichier la région géographique étudiée. Une présentation PowerPoint est ensuite actualisée via des objets liés issus de ces fichiers Excel. Etant donné que mes fichiers Excel sont nombreux, j'ai créé une macro qui ouvre successivement chacun des fichiers, puis modifie l'item du segment en fonction de la région choisie par l'utilisateur, et enfin sauvegarde le fichier avant de le fermer et de passer au suivant.

Jusque là, tout fonctionne à la perfection, sauf qu'il y a une erreur qui me semble pourtant simple, mais que je n'arrive pas à gérer : que faire si le fichier Excel ne contient pas de segment "Région", voir pas de Segment du tout ? Jusque là, la Macro s'arrête et ne réalise le traitement que pour les fichiers situés avant ce fichier sans segment. Je pourrais bien-sûr supprimer le fichier sans segment "Région", mais comme je ne serai pas le seul utilisateur, je préfère gérer ce problème de manière automatique.

Pour vous illustrer mon propos, voici la macro qui me sert d'automatisation :

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
 
Public Sub SelectionRegionPourChaqueFichier(NomRegion As String, NomSegment As String)
 
Dim chemin As String
 
Application.ScreenUpdating = False
 
On Error Resume Next
 
chemin = DefFoldersPath 'Appelle une procédure de définition du chemin d'accès des fichiers
 
ChDir chemin
monfichier = Dir("*.xlsx") 'Pour chaque fichier avec l'extention .xlsx
 
While monfichier <> ""
 
    Workbooks.Open monfichier
    Call parametrageSegment(NomRegion, NomSegment) 'Appelle une procédure de sélection d'un item Slicer
    ActiveWorkbook.Close SaveChanges:=True
    monfichier = Dir()
Wend
 
Application.ScreenUpdating = True
 
End Sub

Et voici celle qui me permet de sélectionner l'item :

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
 
Public Sub parametrageSegment(nomItem As String, NomSegment As String)
 
On Error GoTo ERREUR
 
 
    ActiveWorkbook.SlicerCaches(NomSegment).ClearManualFilter
 
    With ActiveWorkbook.SlicerCaches(NomSegment)
 
        If nomItem = "Tous" Or nomItem = "Toutes" Then
            Exit Sub
        End If
 
 
        For i = 1 To .SlicerItems.Count
 
            If .SlicerItems(i).Name = nomItem Then
                .SlicerItems(i).Selected = True
            Else
                .SlicerItems(i).Selected = False
            End If
 
        Next i
 
    End With
 
Exit Sub
 
ERREUR:
MsgBox "L'erreur suivante s'est produite : " _
        & Err.Description, vbCritical, "Erreur dans la sélection" _
        & " du Segment"
 
End Sub

M'excusant pour les potentielles aberrations de programmation, je reste novice et autodidacte et vous remerciant pour votre aide.

Bien Cordialement

[PMO2017]

Bonjour,

Peut être en transformant la procédure Sub en Function avec une valeur de retour (ici, un Boolean OU autre si vous préférez)

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
Public Sub SelectionRegionPourChaqueFichier(NomRegion As String, NomSegment As String)
 
Dim chemin As String
 
Application.ScreenUpdating = False
 
On Error Resume Next
 
chemin = DefFoldersPath 'Appelle une procédure de définition du chemin d'accès des fichiers
 
ChDir chemin
monfichier = Dir("*.xlsx") 'Pour chaque fichier avec l'extention .xlsx
 
While monfichier <> ""
 
    Workbooks.Open monfichier
 
'///   
Dim IsErreur As Boolean
IsErreur = parametrageSegment(NomRegion, NomSegment) 'Appelle une procédure de sélection d'un item Slicer
If IsErreur Then
  '... Traitement de l'erreur
End If
'sinon, on continue
'///
 
    ActiveWorkbook.Close SaveChanges:=True
    monfichier = Dir()
Wend
 
Application.ScreenUpdating = True
 
End Sub
 
'/// On transforme la procédure Sub en Function avec une valeur de retour (ici, un Boolean OU autre si vous préférez) ///
Public Function parametrageSegment(nomItem As String, NomSegment As String) As Boolean
 
On Error GoTo ERREUR
 
 
    ActiveWorkbook.SlicerCaches(NomSegment).ClearManualFilter
 
    With ActiveWorkbook.SlicerCaches(NomSegment)
 
        If nomItem = "Tous" Or nomItem = "Toutes" Then
            Exit Function
        End If
 
 
        For i = 1 To .SlicerItems.Count
 
            If .SlicerItems(i).Name = nomItem Then
                .SlicerItems(i).Selected = True
            Else
                .SlicerItems(i).Selected = False
            End If
 
        Next i
 
    End With
 
'--- Retour ---
parametrageSegment = False
Exit Function
 
ERREUR:
MsgBox "L'erreur suivante s'est produite : " _
        & Err.Description, vbCritical, "Erreur dans la sélection" _
        & " du Segment"
'--- Retour ---
parametrageSegment = True
End Function

[Scregneugneu]

Bonjour,

Désolé de répondre aussi tardivement, mais votre astuce a parfaitement fonctionné !

Encore merci pour votre aide

Voici mon code final :

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
Public Function parametrageSegment(nomItem As String, NomSegment As String) As Boolean
 
On Error GoTo erreur
 
    ActiveWorkbook.SlicerCaches(NomSegment).ClearManualFilter
 
    With ActiveWorkbook.SlicerCaches(NomSegment)
 
        If nomItem = "Tous" Or nomItem = "Toutes" Then
            Exit Function
        End If
 
        For i = 1 To .SlicerItems.Count
 
            If .SlicerItems(i).Name = nomItem Then
                .SlicerItems(i).Selected = True
            Else
                .SlicerItems(i).Selected = False
            End If
 
        Next i
 
    End With
 
'--- Retour ---
parametrageSegment = True
 
Exit Function
 
erreur:
'MsgBox "L'erreur suivante s'est produite : " _
        & Err.Description, vbCritical, "Erreur dans la sélection" _
        & " du Segment"
 
'--- Retour ---
parametrageSegment = False
 
End Function