Discussion :

[graphikris]

Bonjour,

Dans un classeur je dispose de 2 feuilles.
La 1ere se nomme "Data" et la 2ème "Planning"
Sur Data se trouve en :
C2, une date de début fixée
D2, une date de fin fixée
F2, une date de début réelle
G2, une date de fin réelle

Sur Planning se trouve en :
D1 : 01/01/2016
E1 : 02/01/2016
etc jusqu'en NE1 : 31/12/2016

Je voudrais qu'en fonction de la date située en C2 sur "Data", je puisse masquer sur "Planning" les colonnes D1 à .... qui ne correspondent pas à C2 sur "Data" et à D? sur "Data".
Pour faire simple, si en C2 "Data", j'ai 04/01/2016 alors les colonnes D, E et F doivent être masquées et de plus si D2 sur "Data" est 16/01/2016 alors masquer les colonnes T à NE.
Attention mon tableau "Data" va jusqu'à la ligne 50.

[Invité]

Bonjour,

Le fichier joint Pièce jointe 221820 contient les deux macros suivantes dans un module standard :

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
 
Option Explicit
 
Sub MasquerLesColonnesDuPlanning(ByVal AireCalendrierPlanning As Range, ByVal DateDebut As Date, ByVal DateFin As Date)
 
Dim CelluleCalendrier As Range
 
    AireCalendrierPlanning.Columns.Hidden = False
 
    For Each CelluleCalendrier In AireCalendrierPlanning
        Select Case CDate(CelluleCalendrier)
               Case Is < DateDebut
                    CelluleCalendrier.EntireColumn.Hidden = True
               Case Is > DateFin
                    CelluleCalendrier.EntireColumn.Hidden = True
        End Select
    Next CelluleCalendrier
 
 
End Sub
 
 
Sub TrouverLeCoupleExecutantTache(ByVal AireExecutants As Range, ByVal CoupleExecutantTache As String)
 
Dim CelluleExecutant As Range
 
    For Each CelluleExecutant In AireExecutants
        If CelluleExecutant & " " & CelluleExecutant.Offset(0, 1) = CoupleExecutantTache Then
         Application.GoTo Reference:=CelluleExecutant, Scroll:=True
           Exit For
        End If
    Next CelluleExecutant
 
End Sub

La première macro correspond à votre demande. La deuxième permet de "scroller" sur le couple Exécutant-Tâche dans l'onglet Planning. Le couple cherché s'affiche en haut de la fenêtre.

Pour cela,

Deux zones nommées sont créées dans l'onglet Planning :
- CalendrierPlanning (les dates de votre calendrier).
- ZoneExecutants

Pour activer le tout, clic droit sur une cellule de la colonne C (date début), et dans le module de l'onglet Data :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
 
    If Target.Count > 1 Then Exit Sub
 
    If Not Intersect(Target, Range("C2:C50")) Is Nothing Then
           MasquerLesColonnesDuPlanning Sheets("Planning").Range("CalendrierPlanning"), CDate(Target), CDate(Target.Offset(0, 1))
           TrouverLeCoupleExecutantTache Sheets("Planning").Range("ZoneExecutants"), Sheets("Data").Cells(Target.Row, 1) & " " & Sheets("Data").Cells(Target.Row, 2)
           Cancel = True
    End If
End Sub

Cordialement.

[graphikris]

Bonjour Eric et un grand merci pour votre aide mais ce n'est pas trop ce que je voulais faire.
Je me suis certainement mal expliqué.

En fait je cherche a faire disparaître les colonnes qui se trouvent avant la date la plus petite de la colonne C "Data" et également toutes les colonnes de droite qui se situent après la date la plus grande en colonne D "Data".

Par contre si j'ai une date inscrite en F "Data" plus petite que celle de la colonne C alors il faut qu'elle apparaisse.

Idem pour les colonnes de droite, si j'ai une date inscrite en G "Data" plus grande que celle en D alors il faut qu'elle apparaisse.

Les lignes n'ayant pas de taches et d'exécutants ne doivent pas apparaître (dans mon exemple de la ligne 10 à 99)

le but de tout ceci est d'imprimer en A3 sur une seule feuille mon planning de taches.

Les couleurs mises sur la feuille Planning se mettent en fonction des dates (voir dans les MEFC)

J'ai aussi un souci sur la colonne B "Planning", elle devrait se mettre au bonne dimension en fonction du texte.

Tout ceci change pas mal de chose par rapport a votre travail déjà effectué mais je vous vous remercie tout de meme.

[RyuAutodidacte]

Bonsoir,
Voilà un code permettant de cacher les colonnes dans planning et de faire l'ajustement des colonne B

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
Sub CacheColonne()
Dim RngDebut As Range, RngFin As Range, DateD As Range, DateF As Range, i&, VA
 
    With Sheets("Data")
        Set RngDebut = Union(.Range(.Cells(2, 3), .Cells(Rows.Count, 3).End(xlUp)), .Range(.Cells(2, 6), .Cells(Rows.Count, 6).End(xlUp)))
        Set RngFin = Union(.Range(.Cells(2, 4), .Cells(Rows.Count, 4).End(xlUp)), .Range(.Cells(2, 7), .Cells(Rows.Count, 7).End(xlUp)))
        .Columns("B:B").EntireColumn.AutoFit
    End With
 
    Set DateD = RngDebut.Find(CDate(WorksheetFunction.Min(RngDebut)))
    Set DateF = RngFin.Find(CDate(WorksheetFunction.Max(RngFin)))
 
Application.ScreenUpdating = False
    With Sheets("Planning")
            .Cells.EntireColumn.Hidden = False
            VA = .Range(.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToLeft)).Value
        For i = 4 To UBound(VA, 2)
            If VA(1, i) = DateD Then .Range(.Cells(1, 4), .Cells(1, i - 1)).EntireColumn.Hidden = True
            If VA(1, i) = DateF Then .Range(.Cells(1, i + 1), .Cells(1, Columns.Count).End(xlToLeft)).EntireColumn.Hidden = True: Exit Sub
        Next
        .Columns("B:B").EntireColumn.AutoFit
    End With
Application.ScreenUpdating = True
 
Set RngDebut = Nothing: Set RngFin = Nothing: Set DateD = Nothing: Set DateF = Nothing
 
End Sub

Edit : ayant fait mon post tard je rajoute un peu de texte et l'ajustement des colonne B (oublié) - libre à toi de créer des évènement

[Invité]

OK,

Ci-joint mon fichier adapté Pièce jointe 221932

Dans le module standard :

L'aire des exécutants dans l'onglet Planning est fixée par la dernière cellule de la colonne 3.

Précision importante : Seuls les couples présents dans Data sont représentés dans Planning.

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
 
Option Explicit
 
 
Sub MasquerLesColonnesDuPlanning(ByVal AireCalendrierPlanning As Range, ByVal DateDebut As Date, ByVal DateFin As Date)
 
Dim CelluleCalendrier As Range
 
    AireCalendrierPlanning.Columns.Hidden = False
 
    For Each CelluleCalendrier In AireCalendrierPlanning
        Select Case CDate(CelluleCalendrier)
               Case Is < DateDebut
                    CelluleCalendrier.EntireColumn.Hidden = True
               Case Is > DateFin
                    CelluleCalendrier.EntireColumn.Hidden = True
        End Select
    Next CelluleCalendrier
 
End Sub
 
 
 
Sub MasquerLesLignesSansExecutantEtSansTache(ByVal AireExecutantsPlanning As Range, ByVal AireExecutantsData As Range)
 
Dim CellulePlanning As Range
Dim CelluleData As Range
Dim CellulePlanningFusionnee As Range
Dim CoupleTrouve As Boolean
 
    AireExecutantsPlanning.Rows.Hidden = False
    For Each CellulePlanning In AireExecutantsPlanning
        If CellulePlanning.MergeCells = True Then
            Set CellulePlanningFusionnee = CellulePlanning.MergeArea
            CoupleTrouve = False
            For Each CelluleData In AireExecutantsData
                If CellulePlanningFusionnee(1) & " " & CellulePlanningFusionnee(1).Offset(0, 1) = CelluleData & " " & CelluleData.Offset(0, 1) Then CoupleTrouve = True
            Next CelluleData
            If CoupleTrouve = False Then CellulePlanningFusionnee.EntireRow.Hidden = True
            Set CellulePlanningFusionnee = Nothing
        End If
 
    Next CellulePlanning
 
End Sub

Dans le module de l'onglet Data :
A la fin de la macro, les largeurs des colonnes B sont ajustées.

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
 
Option Explicit
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
 
Dim DateMini As Date
Dim DateMaxi As Date
 
Dim ExecutantsPlanning As Range
Dim ExecutantsData As Range
 
Dim DerniereLigne As Long
 
    If Target.Count > 1 Then Exit Sub
 
    If Not Intersect(Target, Range("C2:C50")) Is Nothing Then
 
           DateMini = WorksheetFunction.Min(Columns(3), Columns(6))
           DateMaxi = WorksheetFunction.Max(Columns(4), Columns(7))
 
           With Sheets("Planning")
                DerniereLigne = .Cells(.Rows.Count, 3).End(xlUp).Row
                If DerniereLigne > 1 Then
                   Set ExecutantsPlanning = .Range(.Cells(2, 1), .Cells(DerniereLigne, 1))
                Else
                    MsgBox "Aucun couple exécutant-tâche dans l'onglet Planning", vbCritical
                    Exit Sub
                End If
           End With
           With Sheets("Data")
                DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
                If DerniereLigne > 1 Then
                   Set ExecutantsData = .Range(.Cells(2, 1), .Cells(DerniereLigne, 1))
                Else
                    MsgBox "Aucun couple exécutant-tâche dans l'onglet Data", vbCritical
                    Exit Sub
                End If
           End With
 
           ' Comme le calendrier a grossi, le temps de traitement est plus long
           '-------------------------------------------------------------------
           Application.ScreenUpdating = False
           MasquerLesColonnesDuPlanning Sheets("Planning").Range("CalendrierPlanning"), DateMini, DateMaxi
           MasquerLesLignesSansExecutantEtSansTache ExecutantsPlanning, ExecutantsData
           Application.ScreenUpdating = True
 
 
           ' Pour ajuster la largeur des colonnes B
           '---------------------------------------
           ExecutantsData.Offset(0, 1).EntireColumn.AutoFit
           ExecutantsPlanning.Offset(0, 1).EntireColumn.AutoFit
 
           Cancel = True
 
           Set ExecutantsPlanning = Nothing
           Set ExecutantsData = Nothing
 
    End If
 
End Sub

Dans le module de l'onglet Planning :
Un clic droit sur la cellule A1 ré-affiche toutes les cellules.

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
 
Option Explicit
 
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
 
 
    If Target.Count > 1 Then Exit Sub
 
    If Not Intersect(Target, Range("A1")) Is Nothing Then
           Rows.Hidden = False
           Columns.Hidden = False
           Cancel = True
    End If
 
End Sub

Cordialement.

[RyuAutodidacte]

Re,
je reviens car sur l'un des post auquel j'avais participé @patricktoulon avait un truc de sympa que je ne connaissait pas, qui permet d'ajouter dans le clic Droit le menu pour lancer la macro cela évite que la macro se lance à tout bout de champs et on la lance quand on le souhaite, je remets l'ensemble des codes :

• Dans un modules 3 petites Macros :

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
Sub Menu()
        resetmenu
    Set newpop = CommandBars("Cell").Controls.Add(msoControlButton, before:=1)
    With newpop
        '.BeginGroup = True
        .Caption = "MASQUER LES COLONNES"
        .OnAction = "CacheColonne"
    End With
 
    Set newpop = CommandBars("Cell").Controls.Add(msoControlButton, before:=2)
    With newpop
        '.BeginGroup = True
        .Caption = "AFFICHER LES COLONNES"
        .OnAction = "AfficheColonne"
    End With
 
End Sub
 
Sub CacheColonne()
Dim RngDebut As Range, RngFin As Range, DateD As Range, DateF As Range, i&, VA
 
    With Sheets("Data")
        Set RngDebut = Union(.Range(.Cells(2, 3), .Cells(Rows.Count, 3).End(xlUp)), .Range(.Cells(2, 6), .Cells(Rows.Count, 6).End(xlUp)))
        Set RngFin = Union(.Range(.Cells(2, 4), .Cells(Rows.Count, 4).End(xlUp)), .Range(.Cells(2, 7), .Cells(Rows.Count, 7).End(xlUp)))
        .Columns("B:B").EntireColumn.AutoFit
    End With
 
    Set DateD = RngDebut.Find(CDate(WorksheetFunction.Min(RngDebut)))
    Set DateF = RngFin.Find(CDate(WorksheetFunction.Max(RngFin)))
 
Application.ScreenUpdating = False
    With Sheets("Planning")
            .Cells.EntireColumn.Hidden = False
            VA = .Range(.Cells(1, 1), .Cells(1, .Columns.Count).End(xlToLeft)).Value
        For i = 4 To UBound(VA, 2)
            If VA(1, i) = DateD Then .Range(.Cells(1, 4), .Cells(1, i - 1)).EntireColumn.Hidden = True
            If VA(1, i) = DateF Then .Range(.Cells(1, i + 1), .Cells(1, Columns.Count).End(xlToLeft)).EntireColumn.Hidden = True: Exit Sub
        Next
        .Columns("B:B").EntireColumn.AutoFit
    End With
Application.ScreenUpdating = True
 
Set RngDebut = Nothing: Set RngFin = Nothing: Set DateD = Nothing: Set DateF = Nothing
 
End Sub
 
Sub AfficheColonne()
Application.ScreenUpdating = False
Sheets("Planning").Columns.EntireColumn.Hidden = False
Application.ScreenUpdating = True
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub resetmenu()
    Application.CommandBars("Cell").Reset
End Sub

• Dans ThisWorkbook :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Menu
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    resetmenu
End Sub

Edit : j'ai pris en compte "Début fixé"/"Début réel" dans RngDebut et "Fin Fixée"/"Fin réelle" dans RngFin Avec Union pour le masquage des colonnes
si tu veux juste Début fixé" ou "Début réel" il suffit de changer la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set RngDebut = .Range(.Cells(2, 3), .Cells(Rows.Count, 3).End(xlUp)) 'pour début fixé ici

Idem pour "Fin Fixée"/"Fin réelle"

Edit 2 : pour mettre à jour avec de nouvelles dates il faut juste Faire Clic droit et utiliser la même macro pour masquer les colonnes : "MASQUER LES COLONNES"


Edit 3 : Ajout de codes