Microsoft 365 DoubleClic sur TCD : Actions différentes selon le niveau

RSone · 29 Février 2020

Bonjour à tous,
je fais appel à vos lumières pour une petit soucis de doubleclic sur un TCD sous forme de tableau.

Exposé du problème :
J'ai donc un TCD avec 3 niveaux empilés les uns sur les autres dans ma 1ère colonne (Régions/Départements/Communes).
Le tableau se plie et se déplie en fonction d'un doubleclic sur cette colonne.
1er niveau : Quand je doubleclic sur une région, les départements s'affichent en dessous (et se masquent si je redoubleclic sur la région).
2eme niveau : Quand je clic sur département, il m'affiche en dessous la liste des communes.
3eme niveau : Quand je clique sur commune, excel ouvre une fenêtre me demandant quels sont les détails de ma table que je souhaite afficher.

Question :
Comment faire pour qu'il ne se passe rien au 3ème niveau et que cette fenêtre excel ne s'ouvre pas ?

Voici mon script ci-dessous.
Pour l'instant plus aucun doubleclic ne fonctionne.

VB:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next ' Pour ne pas avoir d'erreur si seuls les Régions sont affichés (Tableau complétement replieé)

'Comme le TCD change tout le temps je redéfinis les 2 plages :  PlageRégions et PlageDepartements
Dim MaPlageRégions As Range
Dim MaPlageDepartements As Range

    'Je selectionne le niveau 1 et je le nomme MaPlageRégions
        ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect "Régions[All]", xlLabelOnly + xlFirstRow, True
    Set MaPlageRégions = Selection
        ActiveWorkbook.Names.Add Name:="MaPlageRégions", RefersToR1C1:=MaPlageRégions
       
    'Je selectionne le niveau 2 et je le nomme MaPlageDépartements
        ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect "Site[All]", xlLabelOnly + xlFirstRow, True
    Set MaPlageDepartements = Selection
        ActiveWorkbook.Names.Add Name:="MaPlageDepartements", RefersToR1C1:=MaPlageDepartements
        Range("A1").Select
   
    ' J'aimerai que si on doubleclique dans MaPlageRégions ou MaPlageDepartements le TCD s'ouvre normalement comme d'habitude
    ' Je désigne mes 2 plages comme Target
    If Not Application.Intersect(Target, Range("MaPlageRégions, MaPlageDepartements")) Is Nothing Then
        Range("MaPlageRégions, MaPlageDepartements").ShowDetail = True
    Else
    ' Si je clique sur une commune ou bien ailleurs il ne doit rien se passer
        MsgBox "Tu ne peux pas doublecliquer sur les communes"
    Exit Sub
    End If
End Sub

Merci pour votre aide

eriiic · 29 Février 2020

Bonjour,

non, ce n'est pas bon.
tu pourrais partager la solution, c'est le but des forums ;-)
eric

RSone · 29 Février 2020

C'est bon j'ai résolu mon problème tout seul.
Merci

eriiic · 29 Février 2020

Bonjour,

non, ce n'est pas bon.
tu pourrais partager la solution, c'est le but des forums ;-)
eric

RSone · 29 Février 2020

HiHi tu as raison Eric, voici ma solution qui est optimisable mais qui fonctionne.
Malheureusement, j'ai viré les commentaires.
Dans cette solution si un département est déjà déplier pour consulter la liste des communes je le referme avant de déplier le nouveau département doublecliqué.

VB:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

On Error Resume Next
Dim MaPlageRegions As Range
Dim MaPlageDepartements As Range
Dim Nom As String

Nom = Target.Value
    Application.ScreenUpdating = False
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect "Regions[All]", xlLabelOnly + xlFirstRow, True
    Set MaPlageRegions = Selection
    ActiveWorkbook.Names.Add Name:="MaPlageRegions", RefersToR1C1:=MaPlageRegions
    ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotSelect "Departements[All]", xlLabelOnly + xlFirstRow, True
    Set MaPlageDepartementss = Selection
    ActiveWorkbook.Names.Add Name:="MaPlageDepartements", RefersToR1C1:=MaPlageDepartements
    Range("A1").Select
        If Not Application.Intersect(Target, Range("MaPlageRegions, MaPlageDepartements")) Is Nothing Then
                If Not Application.Intersect(Target, Range("MaPlageRegions")) Is Nothing Then
                             If ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Regions").PivotItems(Nom).ShowDetail = False Then
                                ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Departements").ShowDetail = False
                                ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Regions").PivotItems(Nom).ShowDetail = True
                             Else
                                ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Departements").ShowDetail = False
                                ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Regions").PivotItems(Nom).ShowDetail = False
                             End If
                End If
                If Not Application.Intersect(Target, Range("MaPlageDepartements")) Is Nothing Then
                             If ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Departements").PivotItems(Nom).ShowDetail = False Then
                                ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Departements").ShowDetail = False
                                ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Departements").PivotItems(Nom).ShowDetail = True
                             Else
                                ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Departements").PivotItems(Nom).ShowDetail = False
                             End If
                End If
        End If
    Application.ScreenUpdating = True
End Sub

Microsoft 365 DoubleClic sur TCD : Actions différentes selon le niveau

RSone

XLDnaute Nouveau

eriiic

RSone

XLDnaute Nouveau

eriiic

XLDnaute Barbatruc

RSone

XLDnaute Nouveau

Discussions similaires