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