VBA Correction code

Bonsoir à tous,

Vous trouverez ci joint mon fichier comportant un script VBA sur la feuil2 (procédure évènementielle),

Pourriez vous me dire si la syntaxe de la deuxième procédure est correcte car je l'ai écrite moi même avec peu de notion,

Je souhaiterais également ajouter une condition à celle ci qui génèrerai le même message d'alerte si aucun filtre n'est appliquée à la chronologie (Echéance = toutes les périodes),

Merci d'avance pour votre aide,

Cordialement,

Bonjour

Une seul code suffit sinon à chaque fois que utilisez Pivottable(1) dans votre code activate vous appelez le code Pivot Uptadate

Essayez comme ceci plutôt

Private Sub Worksheet_Activate()
Dim D As Date, F As Date

Application.ScreenUpdating = False
On Error Resume Next

D = ThisWorkbook.SlicerCaches(1).TimelineState.FilterValue1
F = ThisWorkbook.SlicerCaches(1).TimelineState.FilterValue2

If F - D > 31 Then
    MsgBox ("Erreur nombre de jours")
    Range("J2") = "Erreur"
    Exit Sub
Else
    Range("J2") = ThisWorkbook.SlicerCaches(1).TimelineState.FilterValue2
End If

With PivotTables(1)
    .PivotCache.Refresh
    .PivotFields("Echéance").ClearAllFilters
    .PivotFields("Echéance").PivotFilters.Add2 _
        Type:=xlDateBetween, Value1:=(Str(Range("G2").Value)), Value2:=(Str(Range("H2").Value))
End With
End Sub

Si ok -->

Crdlt

Bonjour Dan,

Merci tout d'abord pour votre retour, cependant votre proposition ne fait pas ce que je souhaite et ce que j'avais mis en place :

Dans un premier temps, il y a un code pour l’activation de la feuille, celui ci fait :

Actualisation de la requête, rafraichissement du tableau croisé, enlèvement des filtres Echéances puis attribution des valeurs G2 et H2 (Début et fin lors de l'aviation de la feuille)

La deuxième procédure permet d'alerter au cas ou l'utilisateur filtre sur plus de 31 jours : s'il choisit dans le filtre le mois d'Avril, aucune alerte, et au cas où

il choisit deux mois la procédure envoie un message d'alerte,

Mon problème c'est que s'il efface le filtre de la chronologie, le message d'alerte ne fonctionne pas en l'état actuel de mon code !

Au départ je souhaiter empêcher l’accès à l’effacement du filtre chronologique ou de sélectionner plus d'un mois, mais ce n'est pas possible, je me suis donc tourner

vers un message d'alerte.

Merci d'avance,

Cordialement,

La deuxième procédure permet d'alerter au cas ou l'utilisateur filtre sur plus de 31 jours : s'il choisit dans le filtre le mois d'Avril, aucune alerte, et au cas où

Dans le code activate vous appelez 3 x le code pivot_tableupdate

Si vous voulez d'abord rafraichir le TCD, mettez les instructions With......end with, juste avant le On error resume next

Pour bien comprendre, que voulez-vous dire par "filtre chronologique". Donnez moi un exemple éventuellement que je reproduise

Edit : en fait pour modifier ce que je viens de vous écrire, si je fais varier dans le slider Echeance, le code renvoie bien le message d'erreur si sélectionne plus de 31 jours.
Si c'est ce que vous faites, il faut effectivement avoir le code Update en séparé, pour que cela agisse sur le TCD

Bonjour Dan,

Dans le code Activate, j'actualise en premier la requête qui me permet d'afficher la dernière échéance en H6

Me.Range("Tableau1__2").ListObject.QueryTable.Refresh False

Puis j'actualise le TCD pour que les données de celui ci sont à jour

    Me.PivotTables(1).PivotCache.Refresh

et je lui attribue une date de début (G2) et de fin (H2) dans celui-ci en filtre d'échéance (en défiltrant la chronologie et donc les filtres du tcd)

    Me.PivotTables(1).PivotFields("Echéance").ClearAllFilters

    ActiveSheet.PivotTables(1).PivotFields("Echéance").PivotFilters.Add2 _
        Type:=xlDateBetween, Value1:=(Str(Range("G2").Value)), Value2:=(Str(Range("H2").Value))

En activant ainsi la feuille, le tcd et le filtre chronologique sont placés à la date MAX du tableau 1 de la feuil 1

Le deuxième code c'est une fois que l'ulisateur est sur cette feuille, je souhaite qu'il peut naviguer sur la chronologie, mais un mois à la fois sinon il y a une alerte (+ de 31 jours),

La où je coince c'est si il utilise "Effacer le filtre" de la frise chronologie le message n'apparait pas ,

J'espère vous avoir éclairer sur mes demandes?

Merci d'avance,

Cordialement,

Puis j'actualise le TCD pour que les données de celui ci sont à jour

Mais comme je vous ai dit le code worksheet_Pivot table est exécuté trois fois --> A chaque ligne où vous avez Pivottables(1)
Ce qui n'est pas nécessaire

La où je coince c'est si il utilise "Effacer le filtre" de la frise chronologie le message n'apparait pas ,

Si je fais varier par exemple que je déplace à novembre, j'ai bien le message pourtant

Essayez en remplaçant tous ce que vous avez dans la feuille par les codes ci-dessous

1. Code activation feuille

Dim stpevt As Boolean
Private Sub Worksheet_Activate()
Dim D As Date, F As Date
Application.ScreenUpdating = False

Range("Tableau1__2").ListObject.QueryTable.Refresh False

stpevt = True
With PivotTables(1)
    .PivotCache.Refresh
    .PivotFields("Echéance").ClearAllFilters
    .PivotFields("Echéance").PivotFilters.Add2 _
        Type:=xlDateBetween, Value1:=(Str(Range("G2").Value)), Value2:=(Str(Range("H2").Value))
End With
stpevt = False
End Sub

2. Update TCD en fonction du choix de la chronologie

Private Sub worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim D As Date, F As Date

If stpevt = True Then Exit Sub

On Error Resume Next
D = ThisWorkbook.SlicerCaches(1).TimelineState.FilterValue1
F = ThisWorkbook.SlicerCaches(1).TimelineState.FilterValue2

If F - D > 31 Then
    MsgBox ("Erreur nombre de jours")
    Range("J2") = "Erreur"

Else
    Range("J2") = ThisWorkbook.SlicerCaches(1).TimelineState.FilterValue2
End If
End Sub

Dites moi

Bonsoir Dan,

Le code fonctionne par contre pourriez vous me l'expliquer pas à pas ?

A une chose prés, si l’utilisateur utilise Effacer le filtre il n' y a pas de message d'alerte alors que le nombre de jours est bien supérieur à 31 mais ces deux éléments :

D = ThisWorkbook.SlicerCaches(1).TimelineState.FilterValue1
F = ThisWorkbook.SlicerCaches(1).TimelineState.FilterValue2

sont surement "null" c'est pour cela que je n'ai pas de message d'alerte, en fait l'instruction que je ne sais pas écrire dans la procédure "Private Sub worksheet_PivotTableUpdate", réside au fait que si :

ActiveWorkbook.SlicerCaches("ChronologieNative_Echéance").ClearDateFilter est vrai alors le message d'alerte doit apparaitre également,

Sur l'image si utilisateur sélectionne le filtre avec la petite croix rouge, l'alerte ne fonctionne pas,

Au départ mon idée était d’empêcher l'utilisateur de ne pas pouvoir sélectionner "Effacer le filtre (Alt+C)" ou choisir plus d'un mois,

Merci pour votre aide, mis à part cette condition, le code fonctionne mais je ne comprends pas tout son écriture,

Cordialement,

si l’utilisateur utilise Effacer le filtre il n' y a pas de message d'alerte

Ah juste ! Je viens de comprendre votre souci avec le filtre... désolé...

Remplacez votre code par celui-ci

Private Sub worksheet_PivotTableUpdate(ByVal Target As PivotTable)
Dim D As Date, F As Date

If stpevt = True Then Exit Sub
On Error Resume Next

D = ActiveWorkbook.SlicerCaches(1).TimelineState.FilterValue1
F = ActiveWorkbook.SlicerCaches(1).TimelineState.FilterValue2

Select Case F - D
    Case Is > 31, 0
        MsgBox "Choix nombre de jours trop élevé", , "Erreur nombre de jours"
        Range("J2") = "Erreur"

    Case Else: Range("J2") = F
End Select
End Sub

Merci pour votre aide, mis à part cette condition, le code fonctionne mais je ne comprends pas tout son écriture,

Que ne comprenez-vous pas exactement dans le code ?

Bonjour Dan,

C'est juste parfait, cela répond totalement à ma demande,

Je comprends l'ensemble du code, j'ai deux petites questions qui me semblent importantes cependant :

Pourquoi vous mettez dans le code activation feuille la déclaration de la variable "stpevt" avant " Private Sub Worksheet_Activate()" ?

A quoi correspond cette variable 'stepvt"? car elle a une grande importance dans les deux codes que vous m'avez proposé !

Merci d'avance,

A quoi correspond cette variable 'stepvt"? car elle a une grande importance dans les deux codes que vous m'avez proposé !

Oui car lorsque vous activer la feuille le code "worksheet_Activate" est exécuté et chaque fois que le code lit une ligne "pivot...", il exécute aussi le code "PivotTableupdate". Comme vous avez 3 lignes de code dans le "with... End with", le code pivotTableupdate est exécuté 3x inutilement.

Pourquoi vous mettez dans le code activation feuille la déclaration de la variable "stpevt" avant " Private Sub Worksheet_Activate()" ?

En déclarant cette variable en première ligne (donc au dessus de tous les codes), la variable va conserver sa valeur tant que la macro "worksheet_activate" est exécutée.
Si vous regardez le code "worksheet_activate", je mets la variable "stpevt" à TRUE avant d'arriver au "With ..End with".
Quand le code "worksheet_activate" va arriver sur la ligne "pivotTable.refresh", excel va automatiquement aller exécuter le code "PivotTableupdate".
Par le fait d'avoir déclaré la variable "Stpevt" en première ligne de code, sa valeur est conservée lorsque le code "PivotTableupdate" est exécuté. Du coup, lorsque le code "PivotTableupdate" arrive sur la ligne "IF stepevt...." , il ira directement sur l'instruction EXIT SUB pour sortir du code.

Si vous voulez vous rendre compte de ce qui se passe, je vous invite à faire le test comme expliqué ci-dessous :
- allez dans le feuille où sont vos codes
- cliquez sur le ligne "worksheet_activate"
- Appuyez sur F9 de votre clavier pour mettre un point d'arrêt (vous pouvez aussi allez dans le menu "débogage" et sélectionner l'option "basculer au point d'arrêt"). Cela va vous mettre la première ligne en couleur Brune
- allez sur la feuille feuil1 puis sélectionnez la feuil 2 pour exécuter le code. Cette action va arrêter le code sur la ligne où vous avez mis le point d'arrêt.
- Continuez ensuite en appuyant sur la touche F8 ( ou FN + F8 suivant votre clavier) pour exécuter le code ligne par ligne

La touche F8 vous permet de faire du pas à pas dans votre code et de garder le contrôle sur ce que le code lit.

Dites-moi si vous ne comprenez ou n'y arrivez pas

Oups j'ai été long...

Bonjour Dan,

J'ai suivi vos instructions et j'ai très bien comprit avec le pas à pas l'utilité de la variable "stepvt" c'est parfait !!!!!

Dernière question comment traduirais tu cette variable (step vt : pas à pas évènement ?)

Merci pour toute cette aide,

Cordialement,

Dernière question comment traduirais tu cette variable (step vt : pas à pas évènement ?)

Non. stpevt est simplement un nom que j'ai prit comme convention personnelle et qui vient de l'anglais STOP EVENTS
Dans mon cas, j'utilise ce nom dans mes codes car cela me permet de savoir directement le but poursuivi qui est "d'arrêter" ou plutôt d'éviter d'exécuter quelque chose dans un code.

Mais bon on peut utiliser n'importe quoi comme nom (toto, tata, massari...) cela n'a aucune importance, le principal est qu'elle soit de type Boléenne.

Si autres questions ou explications complémentaires, n'hésitez pas

Crdlt

Bonjour Dan,

Merci pour toutes ces explications,

Bonne journée à vous,

Cordialement,

Bonjour Dan,

Sur le code Activation feuille

Dim stpevt As Boolean
Private Sub Worksheet_Activate()
Dim D As Date, F As Date
Application.ScreenUpdating = False

Range("Tableau1__2").ListObject.QueryTable.Refresh False

stpevt = True
With PivotTables(1)
    .PivotCache.Refresh
    .PivotFields("Echéance").ClearAllFilters
    .PivotFields("Echéance").PivotFilters.Add2 _
        Type:=xlDateBetween, Value1:=(Str(Range("G2").Value)), Value2:=(Str(Range("H2").Value))
End With
stpevt = False
End Sub

Je souhaiterai actualisé le tableau structuré T_GB_2 de l'onglet ou la reqûete T_GB, j'ai jouté cette ligne

Range("T_GB_2").ListObject.QueryTable.Refresh False

après l'actualisation du tableau ("Tableau1_2") mais j'ai ce message d'erreur "la méthode range de l'objet worksheet a échoué" que je comprends aisément car le TS n'est pas sur la feuille que l'on active,

j'ai modifié donc le code comme ceci, pouvez vous juste me dire si cela est bien écrit pour la partie T_GB_2 :

Dim stopcode As Boolean
Private Sub Worksheet_Activate()

Dim D As Date, F As Date

Application.ScreenUpdating = False

Range("ECHEANCE").ListObject.QueryTable.Refresh False

Sheets("T_GB_2").Range("T_GB_2").ListObject.QueryTable.Refresh False

stopcode = True

    With PivotTables(1)
        .PivotCache.Refresh
        .PivotFields("DATE").ClearAllFilters
        .PivotFields("DATE").PivotFilters.Add2 _
        Type:=xlDateBetween, Value1:=(Str(Range("F4").Value)), Value2:=(Str(Range("E4").Value))

    End With

stopcode = False

End Sub

Merci d'avance,

Cordialement,

Bonjour Dan,

J'ai modifié :

Sheets("T_GB_2").Range("T_GB_2").ListObject.QueryTable.Refresh False

par

[T_GB_2].ListObject.QueryTable.Refresh False

et j'ai l'impression que ça va plus vite , est ce une impression ?

Merci d'avance,

Cordialement,

et j'ai l'impression que ça va plus vite , est ce une impression ?

Il y a quelques temps Micosoft conseillait de plutôt utiliser Range que les crochets. Ces derniers ralentiraient le code

Je pense que si votre code semble ralentir c'est dû au instructions Query qui sont utilisées pour mettre à jour votre tableau depuis une connexion extérieure.

Pour faire plus simple et vu que vous n'avez qu'un tableau structuré par feuille, modifiez les deux lignes :

Range("ECHEANCE").ListObject.QueryTable.Refresh False
Sheets("T_GB_2").Range("T_GB_2").ListObject.QueryTable.Refresh False

par ceci

Sheets("ANALYSE").ListObjects(1).QueryTable.Refresh False
Sheets("T_GB_2").ListObjects(1).QueryTable.Refresh False

Puis pour la lenteur, fermez toujours excel avant de refaire un test si vous modifiez quelque chose.

La lenteur peut aussi venir de votre PC qui utilise de la mémoire pour autre chose qu'excel pendant que vous utilisez votre fichier.

Bonjour Dan,

Edit ?,

Cordialement,

Bonjour Dan,

Edit ?,

Cordialement,

Oui j'ai modifié ma réponse vu que vous aviez deux posts

Bonjour Dan,

Merci pour ton aide, je n'avais pas vu ton message précédent,

Bon après-midi à vous,

Cordialement,