Discussion :

[philippe.paul]

Bonjour à tous,

Dans l'élaboration d'un planning Excel type "Diagramme de Gantt", je souhaite pouvoir compiler les sous-tâches d'un projet sur une seule ligne de projet.
Voici les différentes étapes à l'ouverture de mon fichier Excel:

1-Actualisation des données d'un tableau avec une liaison base de données Access
2-Mise en forme conditionnelle des cellules entre la date de début et de fin de sous-tâche
3-Insertion d'une ligne en début de chaque projet
4-groupement des sous-tâches par projet

Et là il me manque l'étape 5 qui serait: compilation des sous-tâches sur la ligne principale du projet.

Merci d'avance !

[EricDgn]

Bonjour,

Une façon de faire, à adapter:

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
Sub LigneTaches()
    Dim Dat1 As Date, kR As Long, kRprj As Long, sPrj As String
    Dim kC1 As Long, kC2 As Long
    Dat1 = Range("I3").Value            '--- date intiale
    kR = 6                              '--- n° première ligne de données
    Do
        If Cells(kR, 5) = "" Then       '--- 5 = n° colonne Phase
            '--- tâche vide => est une ligne de titre du groupe
            sPrj = Cells(kR, 4)         '--- 4 = n° colonne Nom projet
            kRprj = kR
        Else
            '--- tâche mentionnée => reporter dans ligne titre du groupe
            If Cells(kR, 8).Value >= Dat1 Then              '--- 8 = n° colonne date Fin
                If Cells(kR, 7).Value < Dat1 Then           '--- 7 = n° colonne date Début
                    kC1 = 9                                 '--- 9 = n° colonne première date données
                Else
                    kC1 = Cells(kR, 7).Value - Dat1 + 9
                End If
                kC2 = Cells(kR, 8).Value - Dat1 + 9
                Debug.Print kRprj, kC1, kC2, Cells(kR, 5).Value
                Cells(kRprj, kC1).Value = Cells(kR, 5).Value
                FormatCellule Range(Cells(kRprj, kC1), Cells(kRprj, kC2))
            End If
        End If
        kR = kR + 1
    Loop Until Cells(kR, 4) = ""
End Sub
 
Sub FormatCellule(r As Range)
    With r.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 10079487
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

Cordialement.

[philippe.paul]

Merci EricDgn !

Cela fonctionne bien. Est ce que l'on peut paramétrer la couleur des cellules de la ligne de tâche (dans ton exemple "FormatCellule" avec une couleur fixe et unique) pour qu'elles reprennent la même couleur que la ligne de sous-tâche correspondante ?

Dans mon fichier de base, il y a une mise en forme conditionnelle basée des cellules des sous-tâches en fonction de la valeur de 2 colonnes ("statut" et "tempo")? Statut: ETUDES ou CONCOURS ou VACANCES - Tempo: 1 ou 2

[EricDgn]

Un début de solution, à compléter/adapter pour prendre en compte les 2 variables

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
Sub LigneTaches()
    Dim Dat1 As Date, kR As Long, kRprj As Long, sPrj As String
    Dim kC1 As Long, kC2 As Long
    Dat1 = Range("I3").Value            '--- date intiale
    kR = 6                              '--- n° première ligne de données
    Do
        If Cells(kR, 5) = "" Then       '--- 5 = n° colonne Phase
            '--- tâche vide => est une ligne de titre du groupe
            sPrj = Cells(kR, 4)         '--- 4 = n° colonne Nom projet
            kRprj = kR
        Else
            '--- tâche mentionnée => reporter dans ligne titre du groupe
            If Cells(kR, 8).Value >= Dat1 Then              '--- 8 = n° colonne date Fin
                If Cells(kR, 7).Value < Dat1 Then           '--- 7 = n° colonne date Début
                    kC1 = 9                                 '--- 9 = n° colonne première date données
                Else
                    kC1 = Cells(kR, 7).Value - Dat1 + 9
                End If
                kC2 = Cells(kR, 8).Value - Dat1 + 9
                Debug.Print kRprj, kC1, kC2, Cells(kR, 5).Value
                Cells(kRprj, kC1).Value = Cells(kR, 5).Value
                FormatCellule Range(Cells(kRprj, kC1), Cells(kRprj, kC2)), Cells(kR, 6).Value
            End If
        End If
        kR = kR + 1
    Loop Until Cells(kR, 4) = ""
End Sub
 
Sub FormatCellule(r As Range, sStatut As String)
    With r.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = -(10079487 * (sStatut = "Etudes") + 13408767 * (sStatut = "Concours") + 6750105 * (sStatut = "Vacances"))
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
End Sub

Cordialement.

[philippe.paul]

Merci EricDgn,

Pour prendre en compte mes 2 variables, je ai associées les 2 champs dans un nouveau champs dès ma base access du type "ETUDES 1", "ETUDE 2", "CONCOURS 1" , ...