Discussion :

[betauser]

Bonjour,

J'ai récupéré une macro qui créée une arborescence à partir des indentations que je spécifie en colonne B.
Je souhaite calculer le min des dates en colonne H et le max des dates en colonne J compte-tenu des cellules de niveau inférieur.
Ci-dessous une capture de mon fichier et le code que j'utilise pour générer les arborescences.
J'ai bien tenté d'intégrer des lignes en ligne au milieu du code (

If Cells(r + 1, 2).IndentLevel > Cells(r, 2).IndentLevel Then ..

.)
mais je dois avouer que mon niveau n'est pas suffisant pour comprendre la macro et donc voir comment l'adapter.

Un grand Merci par avance pour toute info sur la façon d'y parvenir!

Bien cordialement,

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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
Sub wbs()
 
' création de la ref en colonne A, et plan basé sur indentation
'Touche de raccourci du clavier: Ctrl+l
 
'
'From <a href="http://j.modjeska.us/?p=31" target="_blank">http://j.modjeska.us/?p=31</a>
'Renumber tasks on a project plan
'Associate this code with a button or other control on your spreadsheet
 
'Layout Assumptions:
'Row 1 contains column headings
'Column A contains WBS numbers
'Column B contains Task description, with appropriate indentation
'Some text (here we assume "END OF PROJECT") delimits the end of the task list
 
    On Error Resume Next
 
    'Hide page breaks and disable screen updating (speeds up processing)
    Application.ScreenUpdating = False
    ActiveSheet.DisplayPageBreaks = False
    'Format WBS column as text (so zeros are not truncated)
    ActiveSheet.Range("A:A").NumberFormat = "@"
    Dim r As Long                   'Row counter
    Dim depth As Long               'How many "decimal" places for each task
    Dim wbsarray() As Long          'Master array holds counters for each WBS level
    Dim basenum As Long             'Whole number sequencing variable
    Dim wbs As String               'The WBS string for each task
    Dim aloop As Long               'General purpose For/Next loop counter
 
    r = 2                           'Starting row
    basenum = 0                     'Initialize whole numbers
    ReDim wbsarray(0 To 0) As Long  'Initialize WBS ennumeration array
 
    'Loop through cells with project tasks and generate WBS
    Do While Cells(r, 2) <> "FIN"
 
        'Ignore empty tasks in column B
        If Cells(r, 2) <> "" Then
 
           'Skip hidden rows
            If Rows(r).EntireRow.Hidden = False Then
 
                'Get indentation level of task in col B
                depth = Cells(r, 2).IndentLevel
 
                'Case if no depth (whole number master task)
                If depth = 0 Then
 
                    'increment WBS base number
                    basenum = basenum + 1
                    wbs = CStr(basenum)
                    ReDim wbsarray(0 To 0)
 
                'Case if task has WBS depth (is a subtask, sub-subtask, etc.)
                Else
 
                    'Resize the WBS array according to current depth
                    ReDim Preserve wbsarray(0 To depth) As Long
 
                    'Repurpose depth to refer to array size; arrays start at 0
                    depth = depth - 1
 
                    'Case if this is the first subtask
                    If wbsarray(depth) <> 0 Then
 
                        wbsarray(depth) = wbsarray(depth) + 1
 
                    'Case if we are incrementing a subtask
                    Else
 
                        wbsarray(depth) = 1
 
                    End If
 
                    'Only ennumerate WBS as deep as the indentation calls for;
                    'so we clear previous stored values for deeper levels
                    If wbsarray(depth + 1) <> 0 Then
                        For aloop = depth + 1 To UBound(wbsarray)
                            wbsarray(aloop) = 0
                        Next aloop
                    End If
 
                    'Assign contents of array to WBS string
                    wbs = CStr(basenum)
 
                    For aloop = 0 To depth
                        wbs = wbs & "." & CStr(wbsarray(aloop))
                    Next aloop
 
                End If
 
                'Populate target cell with WBS number
                Cells(r, 1).Value = wbs
 
                'Get rid of annoying "number stored as text" error
                Cells(r, 1).Errors(xlNumberAsText).Ignore = True
 
                'Apply text format: next row is deeper than current
                If Cells(r + 1, 2).IndentLevel > Cells(r, 2).IndentLevel Then
 
                    Cells(r, 1).Font.Bold = True
                    Cells(r, 2).Font.Bold = True
                'Else (next row is same/shallower than current) no format
                Else
                    Cells(r, 1).Font.Bold = False
                    Cells(r, 2).Font.Bold = False
                End If
                'Special formatting for master (whole number) tasks)
                If Cells(r, 2).IndentLevel = 0 Then
                    Cells(r, 1).Font.Bold = True
                    Cells(r, 2).Font.Bold = True
                    'Add whatever other formatting you want here
 
                End If
 
            End If
 
        End If
 
    'Go to the next row
    r = r + 1
 
    Loop
 
For r = 1 To r 'optimiser le nb de lignes ici = 10000 par défaut mais chercher la variable au départ
   ActiveSheet.Rows(r).OutlineLevel = Range("B" & r).IndentLevel + 1
Next r
 
End Sub