Discussion :

[philippe.paul]

Bonjour à tous,

Dans la mise en forme d'un diagramme de Gantt Excel, je cherche pour chaque ligne de tâche à copier le texte contenu dans la cellule de la colonne "D" par exemple, dans la cellule correspondant au début de la tâche ou à la 1ère date affichée si la date de début est antérieure à la date du jour ?

[EricDgn]

Bonjour,

Comme si l'on place des formules dans la plage du tableau les textes ne s'étendent plus d'une cellule sur les autres, il ne me semble pas possible de faire cela sans passer par VBA, par exemple ainsi:

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
Option Explicit
 
Sub AjoutTxt(kR As Long)            '--- suppose I3 = première date du tableau
   Dim nJ As Long
   If Cells(kR, 8).Value = "" Then Exit Sub        '--- pas de date Fin
   If Cells(kR, 8).Value < Range("I3").Value Then  '--- 8 = colonne Fin (H)
      '--- anomalie: date Fin précède date du premier jour du tableau
      Cells(kR, 9).Value = "? dépassé"
   Else
      nJ = Cells(kR, 7).Value - Range("I3").Value  '--- 7 = colonne Début (G)
      If nJ < 0 Then nJ = 0
      Cells(kR, 9 + nJ).Value = Cells(kR, 4).Value '--- 9 = colonne I, 4 = colonne D
   End If
   '--- non vérifié: date Début dépasse date dernier jour du tableau
   '--- non vérifié: textes déjà inscrits (et à effacer)
End Sub
 
Sub MajTxt()
   Dim kR As Long
   kR = 6                                 '--- 6 = n° première ligne de données
   While Cells(kR, 4).Value <> ""         '--- parcourir données en colonne n°4 (D)
      AjoutTxt kR
      kR = kR + 1
   Wend
End Sub

Cordialement.

[philippe.paul]

C'est parfait !!

Merci beaucoup EricDgn !!

[philippe.paul]

Je vais maintenant un peu plus loin dans ma mise en forme.

J'aimerai pouvoir regrouper sur la même ligne, les différentes tâches du même projet.

Les étapes serait:

1-insertion d'une nouvelle ligne vierge au début de chaque projet
2-regroupement des tâches sur la ligne vierge.
3-"grouper" les tâches du même projet
4-réduire les groupes pour n'afficher que la ligne de regroupement

Merci d'avance

[EricDgn]

Bonjour,

Pour le point 1:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub NouvellesLignes()         '--- à ne pas répéter plusieurs fois !
   Dim kR As Long
   kR = 6                                 '--- 6 = n° première ligne de données
   While Cells(kR, 4).Value <> ""         '--- parcourir données en colonne n°4 (D)
      If Cells(kR, 4).Value <> Cells(kR - 1, 4).Value Then
         '--- insère une ligne avec le formatage de la ligne en dessous
         Rows(kR).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromRightOrBelow
         Cells(kR, 4).Value = Cells(kR + 1, 4).Value  '--- reprend le nom
      End If
      kR = kR + 1
   Wend
End Sub

pour les ponts 3 et 4:

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
Sub Groupage()
    Dim r As Range
    Dim v As Variant
    Dim i As Long, j As Long
    With ActiveSheet
        On Error Resume Next              '--- erreur si pas de groupe
        .Outline.ShowLevels RowLevels:=8  '--- ouvre tous les groupes
        .Rows.Ungroup                     '--- dégroupe tout
        On Error GoTo 0
        Set r = .Range("D6", .Cells(.Rows.Count, 4).End(xlUp))
    End With
    Debug.Print r.Address
    With r
        '--- parcourt colonne 1 de la plage r pour identifier les groupes
        j = 1
        v = .Cells(j, 1).Value
        For i = 2 To .Rows.Count
            If v <> .Cells(i, 1) Then
                '--- changement de valeur, crée un nouveau groupe
                v = .Cells(i, 1)
                If i > j + 1 Then
                    .Cells(j + 1, 1).Resize(i - j - 1, 1).Rows.Group
                End If
                j = i
                v = .Cells(j, 1).Value
            End If
        Next
        '--- crée le dernier groupe
        If i > j + 1 Then
            .Cells(j + 1, 1).Resize(i - j - 1, 1).Rows.Group
        End If
        '--- réduit tous les groupes
        .Parent.Outline.ShowLevels RowLevels:=1
    End With
End Sub

Pour le point 2, plus compliqué. Il serait préférable de clôturer cette discussion et d'en ouvrir une autre pour ce point.

Cordialement.