Discussion :

[Potzo]

Bonjour à tous,

J'ai créé la macro ci-dessous pour mettre en forme le tableau des tâches. La macro fonctionne globalement bien mais j'aimerais un peu d'aide pour optimiser les points suivants:
- Sa durée: cela prend bien 10 minutes pour un planning de 1500 tâches;
- Lorsqu'elle a parcouru toutes les tâches, j'ai un message d'erreur concernant la validité d'un argument;
- La fonction pour figer l'écran ne s'applique pas (ce qui ne doit pas aider pour la rapidité d'exécution...)

Merci d'avance pour votre aide

Voici la bête :

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
Sub outline()
 
Dim T As Task
Dim PJ As Project
Dim App As Application
 
 
Set App = MSProject.Application
Set PJ = ActiveProject
 
 
With App
    .ScreenUpdating = False 'Attempt to stop the screen refreshing'
    .FilterApply "&All tasks"
    .OutlineHideSubTasks
    .OutlineShowAllTasks
 
 
 
 
For Each T In PJ.Tasks
If Not (T Is Nothing) Then
    If T.Summary = True Then
 
        If T.OutlineLevel = 1 Then
    SelectRow Row:=T.ID, Rowrelative:=False
    Font32Ex CellColor:=2630610
    Font32Ex Color:=16777215
    Font32Ex Name:="Calibri"
    Font32Ex Size:="12"
        End If
 
     If T.OutlineLevel = 2 Then
     SelectRow Row:=T.ID, Rowrelative:=False
    Font32Ex CellColor:=10092543
    Font32Ex Color:=0
    Font32Ex Name:="Calibri"
    Font32Ex Size:="10"
    End If
 
    If T.OutlineLevel = 3 Then
    SelectRow Row:=T.ID, Rowrelative:=False
    Font32Ex CellColor:=10085886
    Font32Ex Color:=0
    Font32Ex Name:="Calibri"
    Font32Ex Size:="10"
    End If
 
    If T.OutlineLevel > 3 Then
        SelectRow Row:=T.ID, Rowrelative:=False
    Font32Ex Name:="Calibri"
    Font32Ex Size:="10"
    Font32Ex Color:=0
    Font32Ex CellColor:=-16777216
    End If
 
Else
    SelectRow Row:=T.ID, Rowrelative:=False
    Font32Ex Name:="Calibri"
    Font32Ex Size:="10"
    Font32Ex Color:=0
    Font32Ex CellColor:=-16777216
 
  End If
End If
 
Next T
    SelectRow Row:=0, Rowrelative:=False
    Font32Ex CellColor:=2630610
    Font32Ex Color:=16777215
    Font32Ex Name:="Calibri"
    Font32Ex Size:="12"
 
    .ScreenUpdating = True
    .FilterApply "&All tasks"
    .OutlineHideSubTasks
    .OutlineShowAllTasks
End With
End Sub

[-XVI-]

Bonjour,

La question est ancienne, mais j'ai un problème similaire.

1) pour accélérer le traitement, on peut utiliser des filtres
(filtrer de manière automatique les lignes où l'on veut que le style s'applique, sélectionner l'ensemble de la page ou de la colonne, appliquer le style).

2) néanmoins, project à l'air de bloquer au delà d'un certain nombre de cellules avec un style défini.

Le bug est assez aléatoire avec plusieurs conséquences possibles :
- suppression de tous les styles définis à un instant t
(lorsque un style est appliqué sur une autre ligne, ou lors d'une sauvegarde, tous les styles précédents sont annulés)
- refus de conserver le style sur certaines cellules seulement
(lorsque l'on modifie l'affichage, le style est effacé sur certaines tâches seulement, mais tjs les mêmes même si on remet le style à la main ensuite).

Quelqu'un connait-il la limite "officielle" de styles pouvant être défini ? est-ce que le nombre de colonne (lorsque le styles est appliquée à toute la ligne) est à comptabiliser dans cette limite ?

Merci

Cordialement,

Xavier V.