Comment valider un message d'avertissement en VBA

Version imprimable

1 pièce(s) jointe(s)

Bonjour à tous,

Dans le cadre d'un outils pour afficher différents indicateurs de performances provenant de plusieurs fichier Excel, je viens vers vous car j'ai un problème que je n'arrive pas à résoudre lors de l'actualisation d'un des fichier :

Le fichier en question contient différents graphiques dynamiques qui s'actualisent automatiquement quand ont choisis l'Item voulu dans le segment.

J'ai fait un code afin d'ouvrir le fichier, choisir un Item dans le segment désiré et de copier le graphique une fois celui ci actualisé avec les bonnes données.

Cependant, pendant l'actualisation des données, j'ai un message d'erreur qui apparait 6/7 fois et je dois le valider manuellement pour que la macro finisse de s'exécuter.

Pièce jointe 214699

J'ai essayé les solutions tel que "Application.DisplayAlerts = False" ou "Sendvkey0" mais ça ne marche pas.

Ci dessous la partie de code avec le segment :
Pour info, choisis l'Item "Prépa" mais c'est l'Item "Obsolète" qui génère un message d'avertissement.
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 With ActiveWorkbook.SlicerCaches("Segment_SecteurResponsable") Application.DisplayAlerts = False .SlicerItems("a").Selected = False .SlicerItems("b").Selected = False .SlicerItems("c").Selected = False .SlicerItems("d").Selected = False .SlicerItems("e").Selected = False .SlicerItems("f").Selected = False .SlicerItems("g").Selected = False .SlicerItems("Obsolete").Selected = False .SlicerItems("h").Selected = False .SlicerItems("i").Selected = False .SlicerItems("j").Selected = False .SlicerItems("k").Selected = False .SlicerItems("Prépa").Selected = True .SlicerItems("l").Selected = False .SlicerItems("m").Selected = False .SlicerItems("n").Selected = False .SlicerItems("o").Selected = False .SlicerItems("p").Selected = False .SlicerItems("q").Selected = False .SlicerItems("r").Selected = False .SlicerItems("s").Selected = False End With
Avez vous une solution pour shunter ou valider ce message ?

Ps, je ne pourrai vous fournir le fichier Excel qui génère ce message.

D'avance merci.

05/07/2016, 09h56
casefayere

1 pièce(s) jointe(s)

Bonjour,
ce message ne ressemble pas à un message Windows ou Office
je pense qu'il est provoqué par le concepteur du programme, tu dis avoir conçu ce code mais je ne pense pas que tu sois à l'origine du fichier ?
si ce que je soupçonne est exact, vas chercher la procédure qui amène ce message, simplement avec l'outil "Rechercher" de l'éditeur : Outil Édition => Rechercher

Pièce jointe 214708

tu trouveras peut-être l'événement qui provoque ce message
05/07/2016, 10h32
Ben1325

Je me suis peut être mal exprimé mais non, ce n'est pas moi qui ai codé le fichier Excel qui génère ce message. moi j'en code un autre qui va chercher des graphiques dans celui là.

J'ai trouvé la cause grâce à "rechercher", et il s'agit bien d'une MsgBox.

Au final j'ai mis SendKeys "{ENTER}", False devant les 7 lignes qui me posait problème. Je ne suis pas sûr que ce soit la bonne solution mais ça marche.. !

Merci à toi.
05/07/2016, 10h42
casefayere

Citation:

Au final j'ai mis "endKeys "{ENTER}", False" devant les 7 lignes qui me posait problème. Je ne suis pas sûr que ce soit la bonne solution mais ça marche.. !

si vraiment ce message ne sert à rien, il vaut mieux supprimer sa procédure que de passer par des Sendkeys
05/07/2016, 10h57
Ben1325

Je vais me renseigner dessus afin de voir s'il a vraiment une utilité ou non.
05/07/2016, 11h03
casefayere

envoies son code...

Code:

1
2
3
4
5
6
7
8
9
10
11
12
If CurSlicer2nd Is Nothing Then
                            'si il n'y a aucun slicer commun alors on ne peut faire correspondre le filtre
                            'CurSlicer2nd.SlicerCache.ClearManualFilter
                            If UCase(tblo(1, i)) Like "*OBJECTIF*" Then
                                If Err_Objectif = False Then
                                    MsgBox "Le filtre sur le champ '" & CurSlicer.Caption & "' n'est pas applicable aux mesures N-1! " & Chr(10) _
                                        & "Les coûts de l'année précédente et les objectifs sont donc nuls pour ce filtre.", vbExclamation, "Incohérence filtre Objectif"
                                    Err_Objectif = True
                                End If
                            ElseIf UCase(tblo(1, i)) Like "*REFACST*" Then
                                Err_Refacst = True
                            End If

Voilà.

05/07/2016, 13h45
casefayere

Non le code complet avec "Sub" ou "Private Sub", c'est important !

Le voilà, à ce que j'ai compris c'est pour comparer les choix entre les différents segments.

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
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
Sub ReadAndReport_SlicersSelectionTo2ndSlicersGroup(Pt_Updated As PivotTable, Pt_2nd As PivotTable)
 
Dim tcd As PivotTable
Dim TcdFields As PivotFields
Dim CurPivotfield As PivotField
Dim ColSlicer As Slicers
Dim CurSlicer As Slicer
Dim ItSlicer As SlicerItem
 
Dim ColSlicer2nd As Slicers
Dim CurSlicer2nd As Slicer
Dim SlicerItem2nd As SlicerItem
 
Dim tblo()
Dim it As Variant
Dim SlicerImpacté As String
 
Dim TrueIts As Collection: Set TrueIts = New Collection
'Dim CurSlicerC As SlicerCache
 
Dim ListeItSlicer As String
Dim Décalage As Integer
Const départ As String = "A1"
Const départ2 As String = "A3"
 
 
Dim Err_Objectif As Boolean: Err_Objectif = False
Dim Err_Refacst As Boolean: Err_Refacst = False
 
'PrecCalculationMode = Application.Calculation
'Application.Calculation = xlCalculationManual
 
 
    Set tcd = Pt_Updated
    Set TcdFields = tcd.PivotFields
    Set ColSlicer = tcd.Slicers
 
 
    'Set ColSlicer2nd = Pt_2nd.Slicers
 
    For Each CurSlicer In ColSlicer
        'Chargement du champs du tcd cible pour utiliser la propriété #AllItemsVisible#
        On Error Resume Next
        Set CurPivotfield = TcdFields(CurSlicer.SlicerCache.SourceName)
        On Error GoTo 0
 
        Erase tblo
        If LinkedSlicers(CurSlicer, tblo) Then
            For i = 0 To UBound(tblo, 2)
                SlicerImpacté = tblo(0, i)
 
 
                If SlicerImpacté = "" Then
                    'si il n'y a aucun slicer commun alors on ne peut faire correspondre le filtre
                    If Sheets("config-").Range("B25").Value = "Mode Avec Objectifs" Then
                        MsgBox "Le programme n'a pas trouvé de liaison paramétrer dans 'Vh-LiaisonsSlicers' pour le slicer" & CurSlicer.Name, vbCritical, "_DEV"
                        Err_Objectif = True
                        'GoTo ErrorHandler
                    End If
                Else
 
                   If UCase(SlicerImpacté) = "X" Then 'il s'agit d'un contrôle pour ne pas ignorer l'absence d'un champs de la source impacté et donc invalider les affichages provenants de cette source, puisque l'on ne peut pas filtrer correctement
                    'il faut paramétrer X dans le slicer impacté manaquant et preciser la source devant être impactée...
                        If UCase(tblo(1, i)) Like "*REFACST*" Then
                            If CurPivotfield.AllItemsVisible = False Then
                                'on invalide les données de la source visée car il y a un filtre sur le slicer qui n'a pas d'équivalent sur la source
                                Err_Refacst = True
                            End If
                        End If
                   Else
                        'recherche du slicer jumeau par son nom complété de l'indice #" 2"#
                        Set CurSlicer2nd = Nothing
                        On Error Resume Next
                        'Set CurSlicer2nd = ColSlicer2nd(SlicerImpacté)
                        Set CurSlicer2nd = GetSlicer(SlicerImpacté)
                        On Error GoTo 0
 
                        If CurSlicer2nd Is Nothing Then
                            'si il n'y a aucun slicer commun alors on ne peut faire correspondre le filtre
                            'CurSlicer2nd.SlicerCache.ClearManualFilter
                            If UCase(tblo(1, i)) Like "*OBJECTIF*" Then
                                If Err_Objectif = False Then
                                    MsgBox "Le filtre sur le champ '" & CurSlicer.Caption & "' n'est pas applicable aux mesures N-1! " & Chr(10) _
                                        & "Les coûts de l'année précédente et les objectifs sont donc nuls pour ce filtre.", vbExclamation, "Incohérence filtre Objectif"
                                    Err_Objectif = True
                                End If
                            ElseIf UCase(tblo(1, i)) Like "*REFACST*" Then
                                Err_Refacst = True
                            End If
                            'GoTo ErrorHandler
                        Else
                            If CurPivotfield.AllItemsVisible Then
                                'libération du filtre si aucun filtre appliqué
                                If Slicer_AllItemsVisible(CurSlicer2nd.Name) = False Then
                                    CurSlicer2nd.SlicerCache.ClearManualFilter
                                End If
                            Else
                                'si il y a un filtre appliqué alors l'on parcours tous les éléments de filtre
                                '#Optimisation
                                If CurSlicer2nd.SlicerCache.SlicerItems.Count > 5 Then Déconnecter_1Slicer CurSlicer2nd.SlicerCache.Name
 
                                For Each ItSlicer In CurSlicer.SlicerCache.SlicerItems
 
                                    'chargement de l'élément de filtre
                                    Set SlicerItem2nd = Nothing
                                    On Error Resume Next
                                    Set SlicerItem2nd = CurSlicer2nd.SlicerCache.SlicerItems(ItSlicer.Name)
                                    On Error GoTo 0
 
                                    '##### Application du filtre sur la seconde source
                                    If ItSlicer.Selected And ItSlicer.HasData Then
                                        If InCollection(TrueIts, ItSlicer.Name) = False Then
                                            TrueIts.Add ItSlicer, ItSlicer.Name
                                        End If
                                        If SlicerItem2nd Is Nothing Then
 
                                            'si l'élément sélectionné n'est pas présent alors on ne peut faire correspondre le filtre
                                            If UCase(CurSlicer2nd.SlicerCache.WorkbookConnection.Name) Like "*OBJECTIF*" Then
                                                If Err_Objectif = False Then
                                                    CurSlicer2nd.SlicerCache.ClearManualFilter
                                                    Err_Objectif = True
                                                    MsgBox "Le filtre '" & ItSlicer.Name & "' sur le champ '" & CurSlicer.Caption & "' n'est pas applicable aux mesures N-1! " & Chr(10) _
                                                        & "Les coûts de l'année précédente et les objectifs sont donc nuls pour ce filtre.", vbExclamation, "Incohérence filtre Objectif"
                                                End If
                                                'GoTo ErrorHandler
                                            ElseIf UCase(CurSlicer2nd.SlicerCache.WorkbookConnection.Name) Like "*REFACST*" Then
                                                Err_Refacst = True
                                            End If
 
                                        Else
                                            SlicerItem2nd.Selected = True
                                        End If
                                    Else
                                        'on ne déselectionne sur la 2nd source que lorqu'on ne trouve une correspondance (PARTIEL)
                                        If Not SlicerItem2nd Is Nothing Then SlicerItem2nd.Selected = False
                                    End If
 
                                Next
 
                                'déselection des autres éléments sur objectifs
                                For Each ItSlicer In CurSlicer2nd.SlicerCache.SlicerItems
                                    If InCollection(TrueIts, ItSlicer.Name) = False And ItSlicer.Selected Then ItSlicer.Selected = False
                                Next
 
 
                                '#Optimisation
                                If CurSlicer2nd.SlicerCache.SlicerItems.Count > 5 Then Reconnecter_1Segment CurSlicer2nd.SlicerCache.Name
 
                            End If 'CurPivotfield.AllItemsVisible
                        End If 'CurSlicer2nd = Nothing
                    End If 'SlicerImpacté
                End If 'SlicerImpacté = "X"
            Next
        End If ' LinkedSlicers = true or false
    Next
 
 
 
If Err_Objectif Then
    Sheets("config-").Range("B20") = "Mesure N-1 et Objectif non disponibles"
Else
    'Libération de l'affichage des objectifs
    Sheets("config-").Range("B20") = vbNullString
End If
 
If Err_Refacst Then
    Sheets("config-").Range("B27") = "INDISPONIBLE"
Else
    Sheets("config-").Range("B27") = vbNullString
End If
 
Exit Sub
 
End Sub

05/07/2016, 14h24
casefayere

donc je pense, je ne suis pas compétent dans les "PivotTable", que des garanties sont prises quant aux résultats escomptés, si tu évites ces messages, tu risques certainement d'entrainer des erreurs
05/07/2016, 14h29
Ben1325

J'ai regardé en faisant l'opération manuellement comme si je voulais juste visualiser les graphiques, je trouve les mêmes données.
Je vais quand même suivre un petit moment pour voir si rien ne diffère.

Merci de ton aide.