Discussion :

[magicfly]

Bonjour à tous,

Je suis un débutant en macro et grâce à ce site j'ai réussit à établir une macro! Après beaucoup de grattage de tête cela marche..(enfin a peu près)

je travail sous MSProject mais je souhaite tracer une courbe d'avancement de projet sous excel et cela à partir de MSProject (je souhaite que les opérateurs utilisent cette macro en la lançant de MSProject et que la courbe souhaitée apparaisse sous excel à la fin)

voici mon programme (avec les explications )

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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
Sub Macro3()
 
'je me positionne sur la vue de MSProject souhaité et copie mes 3 colonnes
 
   ViewApply Name:="7 courbe d'avancement"
    SelectTaskColumn Column:="Fin", Additional:=2
    EditCopy
 
 
    'ouvrir un classeur excel
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlcell As Excel.Range
 
    Dim debut As Integer
Dim Fin As Integer
 
   Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
 
    xlApp.Application.ReferenceStyle = xlA1
 
' collage des colonnes dans excel
 
xlApp.ActiveSheet.Range("C9").Select
xlApp.ActiveSheet.Paste
 
xlApp.ActiveSheet.Range("C8").Select
xlApp.ActiveCell.FormulaR1C1 = "Date de Fin"
xlApp.ActiveSheet.Range("D8").Select
xlApp.ActiveCell.FormulaR1C1 = "point de pondération"
xlApp.ActiveSheet.Range("E8").Select
xlApp.ActiveCell.FormulaR1C1 = "avt %"
 
' calcul de la dernière ligne non nulle , utile pour dimensionner les échelles du graphe
 
Fin = xlApp.Sheets(1).Range("C20").End(xlDown).Row
debut = xlApp.Sheets(1).Range("C20").End(xlUp).Row + 1
xlApp.ActiveSheet.Range("A1").Select
xlApp.ActiveCell.FormulaR1C1 = Fin
xlApp.ActiveSheet.Range("A2").Select
xlApp.ActiveCell.FormulaR1C1 = debut
 
 
 
 
'format des cellules 
xlApp.Columns("D:D").Select
    xlApp.Selection.NumberFormat = "General"
    xlApp.Columns("C:C").Select
    xlApp.Selection.NumberFormat = "m/d/yyyy"
    Columns("E:E").Select
    Selection.NumberFormat = "0.00%"
 
' somme des points de pondération
xlApp.ActiveSheet.Range("D1").Select
xlApp.ActiveCell.FormulaR1C1 = "Total points de pondération"
 
xlApp.ActiveSheet.Range("D2").Select
xlApp.ActiveCell.FormulaR1C1 = "=SUM(R9C4:R2002C4)"
 
' trier les dates par ancienneté
 
    xlApp.ActiveWorkbook.Sheets("Feuil1").Select
    xlApp.ActiveSheet.Range("C9:C" & Fin).Select
 
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Feuil1").Sort.SortFields.Add Key:=Range("C9:C" & Fin) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Feuil1").Sort
        .SetRange Range("C9:C" & Fin)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
 
'calcul %avt réel
 
xlApp.ActiveSheet.Range("F8").Select
xlApp.ActiveCell.FormulaR1C1 = "% avt pondéré"
 
Dim j As Integer
   For j = 9 To Fin
 
      xlApp.ActiveSheet.Range("F" & j).Value = ActiveSheet.Range("E" & j) * ActiveSheet.Range("D" & j) / ActiveSheet.Range("D2")
   Next j
 
' calcul avt cumulé
 
xlApp.ActiveSheet.Range("G8").Select
xlApp.ActiveCell.FormulaR1C1 = "% avt cumulé"
 
xlApp.ActiveSheet.Range("G9").Select
xlApp.ActiveCell.FormulaR1C1 = "=R9C6"
 
Dim u As Integer
   For u = 10 To Fin
      xlApp.Sheets(1).Range("G" & u).Value = Sheets(1).Range("G" & u - 1) + Sheets(1).Range("F" & u)
   Next u
 
'% achevé réel final pour vérifier = 100%
 
xlApp.ActiveSheet.Range("F1").Select
xlApp.ActiveCell.FormulaR1C1 = "% avt réel total"
xlApp.ActiveSheet.Range("F2").Select
xlApp.ActiveCell.FormulaR1C1 = "=SUM(R9C6:R2002C6)"
 
'afficher calcul en %
 
Columns("F:G").Select
    Selection.NumberFormat = "0.00%"
 
'redimensionnement auto des cellules
xlApp.ActiveSheet.Columns("C:G").AutoFit
 
'insertion du Graph
 
'Definit les abscisses (colonne A)
Set PlageX = xlApp.ActiveSheet.Range("C9:C" & Fin)
 
'Definit les ordonnées (colonne G)
Set PlageY = xlApp.ActiveSheet.Range("G9:G" & Fin)
 
Set Graph = xlApp.Charts.Add
 
With Graph
 
    .SetSourceData PlageY, xlColumns
    .SeriesCollection(1).XValues = PlageX 'Abscisses
 
 
    .ChartArea.Interior.Color = vbWhite
    .HasDataTable = False 'Table des données visibles
    .HasTitle = True 'Titre visible
    .ChartTitle.Characters.Text = " % avancement dans le temps"
 
End With
  xlApp.ActiveChart.ChartType = xlXYScatterSmooth
  xlApp.ActiveChart.SeriesCollection(1).Name = "=""avancement %"""
 
'rendre visible le classeur ecxel
 
xlApp.Visible = True
 
 
 
End Sub

Je sais qu'il n'est pas trop recommandé d'utiliser des .select tout le temps mais je ne sais pas trop comment faire sans ( j'ai utilisé l'enregistreur)

Ce programme fonctionne mais je dois fermer et ré-ouvrir mon projet sous MSProject si je souhaite lancé la macro une 2nd fois sinon les calculs deviennent erronés! et je ne comprend pas pourquoi...

je ne demande pas une correction du programme mais des conseils afin d'améliorer ce programme.

bien cordialement

val

[Maxence HUBICHE]

Bonjour et bienvenue sur ton premier post

Alors pour les SELECT
Tu écris ceci :

Code :

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

1
2
xlApp.ActiveSheet.Range("F1").Select
xlApp.ActiveCell.FormulaR1C1 = "% avt réel total"

Dans la première ligne tu dis que tu veux sélectionner la cellule ("A1") de la feuille active de ton application Excel.
Dans la deuxième ligne, tu dis vouloir modifier la formule de la cellule active de ton application.
Mais, étant donné que tu viens de sélectionner F1, la cellule active, c'est F1 !
Autrement dit, tu ne veux pas écrire dans la cellule active, mais dans F1.
Donc, tu aurais pu écrire ta phrase ainsi :

Code :

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

xlApp.ActiveSheet.Range("F1").FormulaR1C1 = "% avt réel total"

Concernant le pourquoi du comment ta macro ne se lance qu'une fois, et le pourquoi il faut relancer MSProject, pourrais-tu nous en dire plus sur la manière dont tu t'y prends pour lancer la macro la première fois ?

Merci

[Qwazerty]

Salut
Je n'ai pas put tester le code, donc tu feras les essai, j'ai juste simplifié un peu l'écriture et rajouté quelques commentaires.
Tu déclare des objets au début de ton code, ce qui me semble une bonne idée, mais pourquoi tu ne les utilises pas par la suite, du coup dans la suite de ton code tu utilise xlApp.ActiveSheet ou XlApp.sheets(1) ou encore Activesheet seule.
Alors en écrivant ça c'est peut être moi qui fait fausse route, ActiveSheet est peut être pris dans ton projet MSProject et non pas du classeur Excel généré?

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
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
Option Explicit 'voir unpeu plus bas dans les commentaires au niveau des déclarations de variables
 
Sub Macro3()
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim xlcell As Excel.Range
 
    Dim debut As Integer
    Dim Fin As Integer
    'Par habitude il est (je trouve) pratique de tout déclarer en début de code
    Dim j As Integer
    Dim u As Integer
 
    'Il est bien de mettre le texte "Option explicit" au debut de ton module, ca force VBA a t'imposer de declarer toutes tes variables, ca evite bien des erreurs
     Dim PlageX As Range
     Dim PlageY As Range
     Dim Graph As Chart
 
 
'je me positionne sur la vue de MSProject souhaité et copie mes 3 colonnes
 
   ViewApply Name:="7 courbe d'avancement"
    SelectTaskColumn Column:="Fin", Additional:=2
    EditCopy
 
 
    'ouvrir un classeur excel
 
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    'Pourquoi t'etre arrété la?
    Set xlSheet = xlBook.Sheets("Feuil1")
 
    xlApp.Application.ReferenceStyle = xlA1
 
' collage des colonnes dans excel
 
With xlSheet 'xlSheet etant defini comme la feuil1 du classeur xlBook de xlApp, il n'est plus utile de represiser la totalité du chemin
    .Range("C9").Paste
 
    .Range("C8").Value = "Date de Fin"
    .Range("D8").Value = "point de pondération"
    .Range("E8").Value = "avt %"
 
' calcul de la dernière ligne non nulle , utile pour dimensionner les échelles du graphe
 
    Fin = .Range("C20").End(xlDown).Row
    debut = .Range("C20").End(xlUp).Row + 1
    .Range("A1").Value = Fin
    .Range("A2").Value = debut
 
 
 
 
'format des cellules
'xlApp.Columns("D:D").Select 'Bizarre j'avoue ne pas trop savoir ce que l'on manipule avec l'objet Columns de l'objet Application Excel
'J'aurais plutot vu comme ca, mais bon je peux faire erreur
    .Columns("D:D").NumberFormat = "General"
    .Columns("C:C").NumberFormat = "m/d/yyyy"
    .Columns("E:E").NumberFormat = "0.00%"
 
' somme des points de pondération
    .Range("D1").Value = "Total points de pondération"
 
    .Range("D2").FormulaR1C1 = "=SUM(R9C4:R2002C4)" 'c'est une affaire de choix, mais je trouve plus lisible .Range("D2").Formula = "=SUM(D9:D2002)"
 
' trier les dates par ancienneté
 
    With .Range("C9:C" & Fin).Sort
        .SortFields.Clear
 
        .SortFields.Clear
        .SortFields.Add Key:=Range("C9:C" & Fin), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("C9:C" & Fin)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
 
'calcul %avt réel
 
    .Range("F8").Value = "% avt pondéré"
 
   For j = 9 To Fin
 
      .Range("F" & j).Value = .Range("E" & j) * .Range("D" & j) / .Range("D2")
      'tu peux aussi utilisé l'objet Cells
      .Cells(j, "F") = .Cells(j, "E") * .Cells(j, "D") / .Range("D2") 'je trouve ca plus lisible, mais ca reste personnel
   Next j
 
' calcul avt cumulé
 
    .Range("G8").Value = "% avt cumulé"
 
    .Range("G9").FormulaR1C1 = "=R9C6" 'Ou Formule = "=F9"
 
   For u = 10 To Fin
      .Range("G" & u).Value = .Range("G" & u - 1) + .Range("F" & u)
   Next u
 
'% achevé réel final pour vérifier = 100%
 
    .Range("F1").Value = "% avt réel total"
    .Range("F2").FormulaR1C1 = "=SUM(R9C6:R2002C6)"
 
'afficher calcul en %
 
    .Columns("F:G").NumberFormat = "0.00%"
 
'redimensionnement auto des cellules
    .Columns("C:G").AutoFit
 
'insertion du Graph
 
 
'Definit les abscisses (colonne A)
    Set PlageX = .Range("C9:C" & Fin)
 
'Definit les ordonnées (colonne G)
    Set PlageY = .Range("G9:G" & Fin)
 
    Set Graph = xlApp.Charts.Add
    'icij'aurais plutot utiliser la collection chart du classeur xlBook
    Set Graph = xlBook.Charts.Add
 
With Graph
 
    .SetSourceData PlageY, xlColumns
    .SeriesCollection(1).XValues = PlageX 'Abscisses
 
 
    .ChartArea.Interior.Color = vbWhite
    .HasDataTable = False 'Table des données visibles
    .HasTitle = True 'Titre visible
    .ChartTitle.Characters.Text = " % avancement dans le temps"
 
'Pourquoi ne plus utiliser ton objet Graph??
  'xlApp.ActiveChart.ChartType = xlXYScatterSmooth
  'xlApp.ActiveChart.SeriesCollection(1).Name = "=""avancement %"""
    .ChartType = xlXYScatterSmooth
    .SeriesCollection(1).Name = "=""avancement %"""
End With
'rendre visible le classeur ecxel
 
xlApp.Visible = True
 
 
 
End Sub

++
Qwaz

[magicfly]

bonjour,

J'ai retravaillé ma macro. Grâce à vos raccourcis il y a moins de bug et le code est en effet beaucoup plus lisible... donc déjà merci ...

Il me reste un soucis sur la partie "tri des dates"
(rappel: Fin= dernière ligne non nulle ici 276)

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
 
 'trier les dates par ancienneté
 
 
    With XlSheet.Sort
        .SortFields.Clear
        .Add Key:=Range("C9:C" & Fin) , SortOn:=xlSortOnValues,_
rder:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("C9:C" & Fin)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

cette action de tri de dates s'exécute correctement la première fois mais il n'y a plus de tri si je relance la macro. (et cela que la macro soit lancé à partir de MS VisualBasic (en cliquant sur run) ou directement de MS Project(outil, macro, run ma macro)
le seul moyen est donc de relancer MSProject. Je ne sais pas si vous avez des idées?

je vous remercie encore pour votre aide.

Valentin

[Qwazerty]

Salut
J'ai vu sue tu avais corrigé certaines erreurs de ma part. (Sort sur Feuil et non sur cellule et End with manquant .... et le doublon de ligne )

Par contre je ne comprend pas, une fois le colonne triée, si tu refais un tri derrière, il est normal que rien ne bouge, puisque les données sont déjà triées. Je ne doit pas comprendre quel est ton problème, essai de donner plus d'info ou d'expliquer différemment.

++
Qwaz

[magicfly]

Salut,


J'utilise MSproject pour un planning et j'ai crée cette macro afin de tracer la courbe d'avancement en fonction du temps de ce planning. Et je souhaite que à tout moment à partir de MSProject lancer cette macro afin de pouvoir tracer cette courbe.

Un petit exemple:

1. Je lance la macro à un instant T1 . J'obtiens donc ma courbe sous excel parfaitement

2. Je modifie maintenant mon planning à un instant T2 (sans avoir refermé MSProject) par exemple la tâche "peinture" et dis qu'elle est finie à 100%. Je relance la macro afin d'avoir une nouvelle courbe dans un nouveau excel. Les valeurs d'avancement ont bien changées mais le classement par date n'est plus effectué!!! le seul moyen d'avoir une courbe bonne est de relancer MSProject puis de lancer la macro.

j'espère avoir étais clair dans l'explication de mon problème.

Val

[Qwazerty]

Salut

Ici il y a une erreur

Code :

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

1
2
.Add Key:=Range("C9:C" & Fin) , SortOn:=xlSortOnValues,order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("C9:C" & Fin)

il manque des point devant les ranges

Code :

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

1
2
.Add Key:=.Range("C9:C" & Fin) , SortOn:=xlSortOnValues,order:=xlAscending, DataOption:=xlSortNormal
        .SetRange .Range("C9:C" & Fin)

Il y a autre chose qui me tarabuste au niveau ce code, tu appliques ton tri uniquement sur la colonne C, sans impliquer les autres colonnes contenant des infos, tu désorganises donc tes données.
Je pense qu'il faudrait plutôt faire comme ça

Code :

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

1
2
3
4
5
6
7
8
9
10
    With xlSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=.Range("C9:C" & Fin), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange .Range("A9:G" & Fin)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

la ligne SetRange est en question.

++
Qwaz

[magicfly]

bon après bcp de retard...

en fait il manquait un point devant un Range...

Merci de votre aide en tout cas. et depuis je me suis pas mal amélioré en macro....

A bientôt


val