[RESOLU] Insérer automatiquement des lignes entre 2 TCD

scoubidou35

XLDnaute Occasionnel
Bonjour à tous,

Nouvelle problématique. Je dois mettre en place un document une sorte de tableau de bords avec des TCD.
L'un en dessous de l'autre avec 3-4 lignes pour séparer les tableaux. C'est pour que ca rentre dans une page A4.

Le problème c'est que maintenant quand je fais une mise à jour le tableau du haut et celui du milieu ont besoins de plus de place. J'ai donc une message erreur à cause du manque de place.

Lors d'une précédente question sur le forum (concernant le rajout de ligne automatiquement dans un tableau)
L'une des propositions me permettait de rajouter des lignes à l'aide d'un bouton qui se décalait à mesure que le tableau grandissait.

N'étant que novice, je m'adresse donc aux pros du code...
Est il possible que lors de l'actualisation des TCD les nombre avoir le même principe.
Je m'explique... quand, je fais une actualisation des 3 TCD en même temps le premier TCD va rajouter le nombre de ligne qu'il a besoin décalant ainsi le second TCD qui fera de même et ainsi de suite.

Voila en gros mon idée. J'espère avoir été assez précis sur mon problème.
Merci à tous
 

scoubidou35

XLDnaute Occasionnel
Voilà chris le fichier.
Les TCD se trouvent dans les onglets Fiche ITK et dans fiche d'exposition
J'ai mis une petite note car j'ai essayé de mettre un code pour lier 3 segments de sources différentes avec 2 filtres (SITES et CHAMP) mais je n'arrive pas à le faire fonctionner.
J'ai mis tous les codes dans Workbook.
Merci pour l'aide
 

Pièces jointes

  • RAJOUT LIGNES EN TCD version 3.xlsm
    637.5 KB · Affichages: 19

chris

XLDnaute Barbatruc
Bonjour

Une petite correction du code car j'ai oublié de modifier les 2 Ubound après avoir inversé le tableau.

Cependant le code est prévu pour espacer des TCD.
Il fonctionne bien sur FICHES I.T.K, mais sur Fiche individuelle d'expo Phyto il n'y a qu'un TCD donc il n'est pas prévu pour ce cas que j'ai donc exclu du traitement.

Par ailleurs tu ne peux pas avoir 2 procédures Workbook_SheetPivotTableUpdate dans un même classeur

Il faudrait combiner la synchro des segments et la gestion des lignes mais dans ce cas il est impératif que les segments à synchroniser concernent des TCD d'un même onglet.
Code:
Option Base 1

Private Sub Workbook_SheetPivotTableUpdate(ByVal Sh As Object, ByVal Target As PivotTable)
Dim Ninsert&, espace&, a(), i&, col%, j&, z&
Ninsert = 100 'à adapter
Application.ScreenUpdating = False
ReDim a(1 To Sh.PivotTables.Count, 3)
If UBound(a, 1) = 1 Then Exit Sub

'Synchro segments 
  If Sh.Name = "FICHES I.T.K" And Target.Name = "TCD_1" Then
  Application.EnableEvents = False
  ActiveWorkbook.SlicerCaches("Segment_SITES1").ClearManualFilter
  ActiveWorkbook.SlicerCaches("Segment_SITES2").ClearManualFilter

  For Each Iitem In ActiveWorkbook.SlicerCaches("Segment_SITES").SlicerItems
  Trouve1 = False: Trouve2 = False
  For Each Iitem1 In ActiveWorkbook.SlicerCaches("Segment_SITES1").SlicerItems
  If Iitem1.Name = Iitem.Name Then
  Trouve1 = True
  Iitem1.Selected = Iitem.Selected
  Exit For
  End If
  Next Iitem1
  If Trouve1 = False Then Iitem.Selected = False
 
  For Each Iitem2 In ActiveWorkbook.SlicerCaches("Segment_SITES2").SlicerItems
  If Iitem2.Name = Iitem.Name Then
  Trouve2 = True
  Iitem2.Selected = Iitem.Selected
  Exit For
  End If
  Next Iitem2
  If Trouve2 = False Then Iitem.Selected = False
 
  Next Iitem

  Application.EnableEvents = True
  End If

'Espacement TCD
With Sh
  .Cells.EntireRow.Hidden = False
  For i = 1 To UBound(a, 1)
  a(i, 1) = .PivotTables(i).TableRange2.Row
  a(i, 2) = .PivotTables(i).TableRange2.Rows.Count
  Next
 
  Call tri(a(), 1, UBound(a, 1), 2, 1)
 
  '---insertion ou suppression de lignes---
  For i = 1 To UBound(a, 1) - 1
  espace = a(i + 1, 1) - (a(i, 1) + a(i, 2))
  If espace < Ninsert Then a(i, 3) = Ninsert - espace Else a(i, 3) = Ninsert - espace
 
  Next
 
  For i = UBound(a, 1) To 2 Step -1
  z = a(i - 1, 3)
  If z > 0 Then
  .Rows(a(i - 1, 1) + a(i - 1, 2)).Resize(z).Insert
  ElseIf z < 0 Then
  z = -z
  .Rows(a(i - 1, 1) + a(i - 1, 2)).Resize(z).EntireRow.Delete
  End If
  'Masquage
  .Rows(a(i - 1, 1) + a(i - 1, 2) & ":" & a(i, 1) + a(i - 1, 3) - 2).EntireRow.Hidden = True
  Next
End With
End Sub
 
Dernière édition:

scoubidou35

XLDnaute Occasionnel
OK donc si dans l'avenir j'ai une feuille du même type que Fiche ITK avec 2 ou 3 TDC il faudra le mettre dans un autre classeur et créer une liaison avec ce classeur. J'ai bien compris?
Par contre lorsque tu dis "Il faudrait combiner la synchro des segments et la gestion des lignes mais dans ce cas il est impératif que les segments à synchroniser concernent des TCD d'un même onglet." C'est pour la feuille "Fiche individuelle" et peux tu m'expliquer ce que tu veux dire car j'ai décroché....désolé:confused:.

Donc pour la feuille "Fiche individuelle" qu'est ce que je peux faire ?
 

chris

XLDnaute Barbatruc
Non ce n'est absolument pas ce que j'ai dit !

Tu peux au contraire avoir d'autres onglets comme Fiche ITK dans le même classeur.

Je t'ai mis le code qui fait à la fois la synchro de tes segments et l'espacement des TCD.
Mais j'ai précisé que les TCD dépendant de ces segments doivent être dans un même onglet : cela me parait simple, à comprendre.
C'est le cas de Fiche ITK donc c'est bon.

Pour la fiche individuelle... pourquoi ne pas prévoir cela en pied de page ? Ce sera plus propre qu'un truc qui se déplace, il me semble...
 
Dernière édition:

scoubidou35

XLDnaute Occasionnel
J'y ai pensé mais il y a 2 zones ( je crois que dans le fichier j'ai eu la souris lourde.
Le premier encadrer juste sous le tcd normalement est une zone où on indique s'il y a eu des incidents. Et en dessous le second encadré l'emplacement pour le cachet et la signature. On ne peut pas dans le pied de page. Vu qu'il y a 3 zones (gauche, droite et centre). Je vais regarder ça demain.
En tout cas merci encore pour le temps que tu as consacré. Car j'ai cherché sur internet et a chaque fois ça semblait impossible. Alors que vous vous trouvez je vais pouvoir avancer dans le projet. Merci également à job75.
 

job75

XLDnaute Barbatruc
Bonjour scoubidou35, herve62, chris,

Voici une solution avec des images des TCD, cela peut suffire :
Code:
Private Sub Worksheet_Calculate()
Dim espace, deb As Range, n
espace = 1 'nombre de lignes entre 2 TCD/images
Set deb = [R8] '1ère cellule
Application.ScreenUpdating = False
Application.EnableEvents = False
[A:C].ClearContents 'RAZ
Pictures.Delete 'RAZ
For n = 1 To PivotTables.Count
    With PivotTables(n).TableRange1
        Cells(n, 1) = .Column
        Cells(n, 2) = .Rows.Count
        If .Rows.Count > 2 Then .Offset(1).Resize(.Rows.Count - 2).Interior.ColorIndex = 2 'intérieur blanc
        .CopyPicture
        If .Rows.Count > 2 Then .Offset(1).Resize(.Rows.Count - 2).Interior.ColorIndex = xlNone
    End With
    Paste
    Cells(n, 3) = Selection.Name
Next
ActiveCell.Activate
With [A1].CurrentRegion
    .Sort [A1], xlAscending, Header:=xlNo
    For n = 1 To .Rows.Count
        Shapes(.Cells(n, 3)).Top = deb.Top
        Shapes(.Cells(n, 3)).Left = deb.Left
        Set deb = deb(1 + Cells(n, 2) + espace)
    Next
End With
Application.EnableEvents = True
End Sub
A+
 

Pièces jointes

  • TCD Images(1).xlsm
    47.3 KB · Affichages: 15

scoubidou35

XLDnaute Occasionnel
Bonjour Chris
Je n'ai pas eu le temps de tester ton code que ce matin. Et je galère. Il ne synchronise pas les filtres et je ne comprends pas.
Je t'ai joins le fichier avec ton dernier code en workbook.
J'ai également mis des annotations pour comprendre le code car j'arrive à comprendre des bouts mais pas tous.
Merci
A+
 

Pièces jointes

  • RAJOUT LIGNES EN TCD version 3.xlsm
    629.4 KB · Affichages: 10

chris

XLDnaute Barbatruc
Bonjour

Si tu relis attentivement mon #12, je dis bien qu'il faut espacer au début les TCD de 100 lignes (éventuellement moins si moins suffisent au début) puis le code s'occupera de maintenir 100 lignes...

Comme tu as plusieurs séries de segments j'ai repris un code que j'avais fait, un peu après celui que tu avais trouvé sur Developpez.com, qui fonctionne que l'on utilise les segments de l'un ou l'autre des TCD et l'ai adapté.

A noter que
  • on ne sait pas quel est le segment déclencheur, juste le TCD lié au segment, donc tous les segments sont synchronisés, Sites et Champs.
  • pour Champs il vaut donc mieux partir d'un TCD ayant le plus de cas
  • Si le nombre d'items est important cela peut ne pas être instantané
 

Pièces jointes

  • LignesTCD_.xlsm
    749.4 KB · Affichages: 17

scoubidou35

XLDnaute Occasionnel
Bonjour Chris,
Merci pour les explications mais je ne demandais pas pour l'insertion des 100 lignes je demandais comment faire pour augmenter l'espace entre les tableaux car mon titre en colonne A est à chaque fois masqué.
Sinon j'ai tester le nouveau fichier et je n'ai pas besoin de pouvoir filtrer les tableaux indépendamment. J'ai besoins que quand je sélectionne avec les segments du TCD ITK selon l'ordre SITE, CHAMP
J'avais un code avec lequel on utilisait pas les segments mais les filtres et quand je rentrais les infos dans les cases jaunes à l'aide de liste déroulante dynamique en haut de la feuille ITK
Les filtres se mettaient à jours.


Option Explicit

'Private Sub Worksheet_Change(ByVal Target As Range)
'If Target.Address = "$C$6" Then 'C8
'On Error Resume Next
'ActiveSheet.PivotTables("TCD1").PivotFields("SITES").ClearAllFilters
'ActiveSheet.PivotTables("TCD1").PivotFields("SITES").CurrentPage = Range("C6").Text
'ActiveSheet.PivotTables("TCD1").PivotFields("SITES").CurrentPage = ""

'ActiveSheet.PivotTables("TCD2").PivotFields("SITES").ClearAllFilters
'ActiveSheet.PivotTables("TCD2").PivotFields("SITES").CurrentPage = Range("C6").Text
'ActiveSheet.PivotTables("TCD2").PivotFields("SITES").CurrentPage = ""

'ActiveSheet.PivotTables("TCD3").PivotFields("SITES").ClearAllFilters
'ActiveSheet.PivotTables("TCD3").PivotFields("SITES").CurrentPage = Range("C6").Text
'ActiveSheet.PivotTables("TCD3).PivotFields("SITES").CurrentPage = ""

End If
'If Target.Address = "$C$8" Then

'ActiveSheet.PivotTables("TCD1").PivotFields("CHAMP").ClearAllFilters
'ActiveSheet.PivotTables("TCD1").PivotFields("CHAMP").CurrentPage = Range("C8").Text
'ActiveSheet.PivotTables("TCD1").PivotFields("CHAMP").CurrentPage = ""

'ActiveSheet.PivotTables("TCD2").PivotFields("CHAMP").ClearAllFilters
'ActiveSheet.PivotTables("TCD2").PivotFields("CHAMP").CurrentPage = Range("C8").Text
'ActiveSheet.PivotTables("TCD2").PivotFields("CHAMP").CurrentPage = ""

'ActiveSheet.PivotTables("TCD3").PivotFields("CHAMP").ClearAllFilters
'ActiveSheet.PivotTables("TCD3").PivotFields("CHAMP").CurrentPage = Range("C8").Text
'ActiveSheet.PivotTables("TCD3).PivotFields("CHAMP").CurrentPage = ""


'End If
'End Sub

Le seul problème c'est que si un tableau ne comportait pas d'info le jour de l'actualisation cela bugguait (par exemple en 2019 je crée un champ semé avec TCD1 mais un mois après on me demande de sortir l'ITK de ce champs et qu'il n'y a pas eu ni de traitements ni ET/OU notations alors ça bug. et en plus ça les tableaux ne s'ajustait pas.
ce que je recherche c'est de pouvoir filtrer et que les tableaux s'ajustent.

Je ne suis pas un pro du code loin de là mais je suis volontaire et je veux apprendre, c'est pour cela que je pose des questions.
Mais ce que je vois c'est qu'avec les segments visuellement c'est plus attractif mais il semblerait que ce soit trop compliqué voir impossible de gérer les filtres par segments en synchronisant plusieurs TCD.

Dans la dernière version du fichier, tu as modifié le code mais je suis complètement largué malgré tes annotations dont je te remercie.
Mais si c'est trop compliqué de gérer avec les segments peut on gérer avec les filtres que je masque par la suite? et éviter les bug en cas de non info dans les TCD?


Je suis dispo pour info supplémentaire.
Merci encore pour votre aide.
 

chris

XLDnaute Barbatruc
RE
Merci pour les explications mais je ne demandais pas pour l'insertion des 100 lignes je demandais comment faire pour augmenter l'espace entre les tableaux car mon titre en colonne A est à chaque fois masqué.

C'est c'est partie du code

Code:
'Masquage
  .Rows(a(i - 1, 1) + a(i - 1, 2) & ":" & a(i, 1) + a(i - 1, 3) - 2).EntireRow.Hidden = True
Tu peux mettre -8 au lieu de -2 mais comme ton document n'est pas homogène, des titres ici et pas là cela fera des lignes vides en plus...

Sinon j'ai tester le nouveau fichier et je n'ai pas besoin de pouvoir filtrer les tableaux indépendamment.

Cela ne filtre pas indépendamment ! Tu voulais une synchronisation des segments, je l'ai faite mais tu as 2 segments par TCD et le VBA ne permet pas de savoir sur quel segment tu cliques... d'où ma remarque sur le fait que les 6 sont synchronisés en même temps.

Je me demande si tu testes ce que je t'envoie...

Le problème c'est que la demande évolue au fil des posts
Tu commence par poster une exemple "pris au hasard" avec 3 TCD bien propres et un segment par TCD, qui n'a rien à voir avec le cas réel.
Job et moi-même t'avons proposé, l'un des case à cocher qui ne semblaient pas te convenir, l'autre des segments, mais maintenant rien ne va plus...
 

scoubidou35

XLDnaute Occasionnel
Si, je teste tout ce que vous envoyez
Dans le dernier fichier avec les segments du tcd ITK, j'ai sélectionné Lyon et champ1
J'obtiens bien Lyon partout mais pour ce qui est champ ça n'a pas bougé. Or tu dis que les 6 sont synchronisé en même temps.
Donc je comprends que si tu sélectionnes Lyon champ1 le code vas chercher Lyon champ1 dans les autres tcd comme si je faisais concaténer lyon champs 1. Sa fonctionne pour le premier TCD. Mais a priori, une fois encore, je n'ai pas compris....

Les fichiers que je mets sont excempt de tout les noms de produits et info. Donc je fais de mon mieux. L'idéal serait de pouvoir passer le fichier directement avec la mise en forme et toutes les données.

Je n'ai pas changé ma demande en cours de route si tu relie bien le message initial je demande un moyen qui réajuste l'espace entre mes tableaux selon leur taille pour ne pas que ca bug à cause d'un empiètement de TCD.
Et je demande que cela se réalise avec mes filtres.

Or Job et toi que je remercie encore pour le temps passé et vous respecte car vous maitrisez vraiment
le code et on a la chance sur ce forum d'avoir des têtes comme vous parmi d'autres. C'est ce qui fait le succès du forum.
Vous avez résolu mon problème d'espace mais c'est le problème du filtre qui se pose. Comme ce sont des documents qui évolue dans le temps. Je ne peux pas avoir des checkbox sinon cela veux dire qu'il faudra que j'y revienne régulièrement sur le fichier pour le modifier et c'est pas le but. Je l'ai dis à Job et il me semble qu'il a bien compris et m'a proposé une autre solution mais le problème de filtre était toujours là.

Les segments c'est vraiment plus attrayant dans le document.
Mais s'il le faut je peux m'en passer et créer des cellules avec une liste dynamique déroulante qui commande mais filtres des TCD et que je masquerai par la suite.
Mais le problème c'est d'adapter cela dans le code. A mon avis ca dois changer une bonne partie du code.

Je me tiens dispo si vous avez des questions
Merci encore

A+
 
Dernière édition:

chris

XLDnaute Barbatruc
RE

Lyon et champ 1 fonctionne très bien à condition, comme je l'ai expliqué, de ne pas sélectionner champ1 dans le segment du haut, où ne figurent que quelques champs, mais dans un segment qui les contient tous sinon on n'a aucun moyen de conclure si champ 6 n'est pas sélectionné dans le 1er on ne le sélectionne pas dans les autres... puisque la logique est la déselection et non la sélection...
C'est la limite des segments/TCD liés à des sources de données différentes qui ont en plus un nombre de cas très dissemblable...

Le plus simple est de planquer 4 des segments et ne laisser que 2 visibles, ceux qui ont le plus d'items, cela optimisera... mais n’empêchera pas que si tu sélectionne des champs non présents dans le 1er TCD, il ne sera pas filtré
 

Statistiques des forums

Discussions
311 720
Messages
2 081 909
Membres
101 836
dernier inscrit
karmon