Importation MS Project dans Excel

**JonesKCD** · 05/06/2012, 16h28

Bonjour,

J'ai développé une macro dans Excel permettant d'importer certains champs de plusieurs fichiers MS Project dans une feuille Excel.

Le principe de fonctionnement : on demande à l'utilisateur de spécifier le répertoire dans lequel se trouvent les fichiers MS Project à importer dans Excel
On boucle sur tous les fichier MS Project du répertoire en n'extrayant que les champs désirés (ouverture du fichier, extraction des données, fermeture de la fenêtre MS Project)

Mon problème : L'importation fonctionne correctement à la première itération mais pour les suivantes, les fichiers MS Project sont ouverts sans que l'extraction ne se réalise. Aucun message d'erreur n'apparaît.

Le code utilisé :

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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
Option Explicit
Dim xlCell As Excel.Range
 
Sub Import_from_Suppliers_Entries()
Dim ThisWk      As Workbook
Dim Rep1        As Integer
Dim Rep2        As Integer
Dim objShell    As Object
Dim objFolder   As Object
Dim oFolderItem As Object
Dim Chemin      As String
Dim Fichier     As String
 
Set ThisWk = ThisWorkbook
 
Rep1 = MsgBox("Souhaitez-vous mettre à jour toutes les données du périmètre", vbYesNoCancel, "Mise à jour des données")
If Rep1 = vbYes Then
    Rep2 = MsgBox("ATTENTION : Les données antérieures seront toutes supprimées." & vbCrLf _
            & " Souhaitez-vous procéder à cette mise à jour ?", _
            vbYesNo + vbExclamation, _
            "Confirmation de la mise à jour des données")
    If Rep2 = vbYes Then
        Set objShell = CreateObject("Shell.Application")
        Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
 
        On Error Resume Next
        Set oFolderItem = objFolder.Items.Item
        Chemin = oFolderItem.Path
 
        If Chemin = "" Then
            MsgBox "Vous n'avez sélectionné aucun répertoire." & vbCrLf _
                    & "Le programme de mise à jour ne peut pas s'éxecuter.", _
                    vbInformation
            Exit Sub
        Else
 
            Application.ScreenUpdating = False
 
            ' On supprime les données éventuellement présente sur la feuille
            If ThisWk.ActiveSheet.UsedRange.Rows.Count >= 13 Then
                ThisWk.ActiveSheet.Range(Cells(13, 1), Cells(ThisWk.ActiveSheet.UsedRange.Rows.Count, 1)).EntireRow.Delete
            End If
            Chemin = Chemin & "\"
            Fichier = Dir(Chemin & "*.mpp") ' On boucle sur tous les fichiers MS Project
            Do While Len(Fichier) > 0
                Extract_MSP ThisWk.ActiveSheet, Chemin, Fichier
                Fichier = Dir()
            Loop
 
            Application.ScreenUpdating = True
 
        End If
    Else
        Exit Sub
    End If
 
    Set oFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
 
End If
 
Set ThisWk = Nothing
 
End Sub
 
Sub Extract_MSP(WkSh As Worksheet, Rep As String, FichMSP As String)
Dim t           As Task
Dim pj          As MSProject.Application
Dim DerLig      As Long
Dim DebLigCopy  As Long
Dim xlApp       As Excel.Application
Dim xlBook      As Excel.Workbook
Dim xlSheet     As Excel.Worksheet
Dim Asgn        As Assignment
Dim ColumnCount As Integer
Dim Columns     As Integer
Dim Tcount      As Integer
Dim TmpSh       As Worksheet
Dim i           As Integer
Dim j           As Integer
 
Set TmpSh = ThisWorkbook.Sheets("Template")
'Ouverture de MSProject
Set pj = New MSProject.Application
pj.FileOpen Rep & FichMSP, ReadOnly:=True
pj.Visible = True   ' On affiche la fenêtre MS Project
 
With TmpSh
    DerLig = .Cells(65536, 1).End(xlUp).Row + 1
    If DerLig >= 3 Then .Rows(3 & ":" & DerLig).Delete
 
    Tcount = 0
    For Each t In ActiveProject.Tasks
        If Not t Is Nothing Then
            dwn TmpSh, 1
            xlCell = t.Name
            If t.Summary = False Then
                rgt 2
                xlCell = t.Duration
                rgt 1
                xlCell = t.Start
                rgt 2
                xlCell = t.Finish
                rgt 2
                If t.PercentComplete > 0 And t.PercentComplete <> "" Then
                    xlCell = Format(t.PercentComplete / 100, "0%")
                End If
                rgt 3
                xlCell = t.OutlineLevel
                If t.OutlineLevel > Tcount Then Tcount = t.OutlineLevel
            Else
                rgt 10
                xlCell = t.OutlineLevel
            End If
        End If
    Next t
 
    .Columns(4).NumberFormat = "dd/mm/yy;@"     ' On force le contenu des cellules au format date
    .Columns(6).NumberFormat = "dd/mm/yy;@"
 
    ' On ajoute une ligne permettant d'identifier la source des données
    .Rows(3).Insert Shift:=xlDown
    With .Cells(3, 1)
        .Value = FichMSP                        ' On saisit le nom du fichier source MS Project
        .Font.Bold = False                      ' On supprime la mise en gras de la cellule
        .HorizontalAlignment = xlLeft           ' On aligne les caractères à gauche dans la cellule
        .Resize(1, 11).Interior.ColorIndex = 37 ' On colorie les cellules en bleu
    End With
 
    ' On crée le plan en fonction du niveau hiérarchique des tâches défini dans MS Project
    For j = 1 To Tcount
        For i = 3 To .Cells(65536, 1).End(xlUp).Row
            If .Cells(i, 11).Value >= j Then .Cells(i, 1).Rows.Group
        Next i
    Next j
 
    DerLig = .Cells(65536, 1).End(xlUp).Row
    .Activate
    .Range(Cells(3, 11), Cells(DerLig, 11)).Delete ' On efface les données de niveau hierarchique
    DebLigCopy = WkSh.Cells(65536, 1).End(xlUp).Row + 1
    .Cells.Font.Size = 8    ' On définit la taille des caractères dans toutes les cellules de la feuille
 
    .Rows("3:" & DerLig).Copy        ' On copie les cellules issues de MSP Project
    WkSh.Activate
    ' On colle les cellules dans la feuille contenant le planning GFE correspondant
    WkSh.Cells(DebLigCopy, 1).PasteSpecial _
                                            Paste:=xlPasteAll, _
                                            Operation:=xlNone, _
                                            SkipBlanks:=False, _
                                            Transpose:=False
 
End With
 
pj.Quit
 
Set pj = Nothing
Set TmpSh = Nothing
 
End Sub
Sub dwn(Sh As Worksheet, i As Integer)
 
Set xlCell = Sh.Cells(65536, 1).End(xlUp).Offset(i, 0)
 
End Sub
 
Sub rgt(i As Integer)
 
Set xlCell = xlCell.Offset(0, i)
 
End Sub

Quelqu'un pourrait-il m'aider à solutionner mon problème ?

Merci à tous ceux qui voudront bien se pencher sur ce problème.

**Godzestla** · 06/06/2012, 12h33

Bonjour,

cela sonne comme une erreur de logique.

Prend ton code en debug (Extract_MSP() et tu devrais je pense trouver où le bas blesse.

Peut-etre un problème de feuille active.

**JonesKCD** · 06/06/2012, 16h12

Bonjour Godzestla,

Merci pour ta réponse.
J'avais déjà passé le programme en mode débug.
Je pense avoir trouvé la ligne sur laquelle le code semble éluder le reste du code.

Code :

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

1
2
For Each t In ActiveProject.Tasks
If Not t Is Nothing Then

En mode débug, "ActiveProject.Tasks" prend la valeur <Le serveur distant n'existe pas ou n'est pas disponible.> après avoir correctement traité le premier fichier MS Project.

J'ai beau me tirer les cheveux (à ne plus en avoir sur le caillou) mais je n'arrive pas à comprendre quel est le problème.

Une solution ou une piste, peut-être ?

**JonesKCD** · 08/06/2012, 14h03

J'ai ajouté la fonction DoEvents à différents endroits du programme mais ça ne règle rien. J'ai beau cherché je ne trouve pas de solution.

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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
Option Explicit
Dim xlCell As Excel.Range
 
Sub Import_from_Suppliers_Entries()
Dim ThisWk      As Workbook
Dim Rep1        As Integer
Dim Rep2        As Integer
Dim objShell    As Object
Dim objFolder   As Object
Dim oFolderItem As Object
Dim Chemin      As String
Dim Fichier     As String
 
Set ThisWk = ThisWorkbook
 
Rep1 = MsgBox("Souhaitez-vous mettre à jour toutes les données du périmètre", vbYesNoCancel, "Mise à jour des données")
If Rep1 = vbYes Then
    Rep2 = MsgBox("ATTENTION : Les données antérieures seront toutes supprimées." & vbCrLf _
            & " Souhaitez-vous procéder à cette mise à jour ?", _
            vbYesNo + vbExclamation, _
            "Confirmation de la mise à jour des données")
    If Rep2 = vbYes Then
        Set objShell = CreateObject("Shell.Application")
        Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
 
        On Error Resume Next
        Set oFolderItem = objFolder.Items.Item
        Chemin = oFolderItem.Path
 
        If Chemin = "" Then
            MsgBox "Vous n'avez sélectionné aucun répertoire." & vbCrLf _
                    & "Le programme de mise à jour ne peut pas s'éxecuter.", _
                    vbInformation
            Exit Sub
        Else
 
            Application.ScreenUpdating = False
 
            ' On supprime les données éventuellement présente sur la feuille
            If ThisWk.ActiveSheet.UsedRange.Rows.Count >= 13 Then
                ThisWk.ActiveSheet.Range(Cells(13, 1), Cells(ThisWk.ActiveSheet.UsedRange.Rows.Count, 1)).EntireRow.Delete
            End If
            Chemin = Chemin & "\"
            Fichier = Dir(Chemin & "*.mpp") ' On boucle sur tous les fichiers MS Project
            Do While Len(Fichier) > 0
                Extract_MSP ThisWk.ActiveSheet, Chemin, Fichier
                Fichier = Dir()
            Loop
 
            Application.ScreenUpdating = True
 
        End If
    Else
        Exit Sub
    End If
 
    Set oFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
 
End If
 
Set ThisWk = Nothing
 
End Sub
 
Sub Extract_MSP(WkSh As Worksheet, Rep As String, FichMSP As String)
Dim t           As Task
Dim pj          As MSProject.Application
Dim DerLig      As Long
Dim DebLigCopy  As Long
Dim xlApp       As Excel.Application
Dim xlBook      As Excel.Workbook
Dim xlSheet     As Excel.Worksheet
Dim Asgn        As Assignment
Dim ColumnCount As Integer
Dim Columns     As Integer
Dim Tcount      As Integer
Dim TmpSh       As Worksheet
Dim i           As Integer
Dim j           As Integer
 
Set TmpSh = ThisWorkbook.Sheets("Template")
'Ouverture de MSProject
' On vérifie si MSP n'est pas déjà ouvert
On Error Resume Next
Set pj = GetObject(, "MSProject.Application")
On Error GoTo 0
If pj Is Nothing Then
    Set pj = CreateObject("MSProject.Application")
    DoEvents
    pj.FileOpen Rep & FichMSP, ReadOnly:=True
    DoEvents
    pj.Visible = True   ' On affiche la fenêtre MS Project
End If
 
With TmpSh
    DerLig = .Cells(65536, 1).End(xlUp).Row + 1
    If DerLig >= 3 Then .Rows(3 & ":" & DerLig).Delete
 
    Tcount = 0
    For Each t In Projects(FichMSP).Tasks
        If Not t Is Nothing Then
            dwn TmpSh, 1
            xlCell = t.Name
            If t.Summary = False Then
                rgt 2
                xlCell = t.Duration
                rgt 1
                xlCell = t.Start
                rgt 2
                xlCell = t.Finish
                rgt 2
                If t.PercentComplete > 0 And t.PercentComplete <> "" Then
                    xlCell = Format(t.PercentComplete / 100, "0%")
                End If
                rgt 3
                xlCell = t.OutlineLevel
                If t.OutlineLevel > Tcount Then Tcount = t.OutlineLevel
            Else
                rgt 10
                xlCell = t.OutlineLevel
            End If
        End If
    Next t
 
    .Columns(4).NumberFormat = "dd/mm/yy;@"     ' On force le contenu des cellules au format date
    .Columns(6).NumberFormat = "dd/mm/yy;@"
 
    ' On ajoute une ligne permettant d'identifier la source des données
    .Rows(3).Insert Shift:=xlDown
    With .Cells(3, 1)
        .Value = FichMSP                        ' On saisit le nom du fichier source MS Project
        .Font.Bold = False                      ' On supprime la mise en gras de la cellule
        .HorizontalAlignment = xlLeft           ' On aligne les caractères à gauche dans la cellule
        .Resize(1, 11).Interior.ColorIndex = 37 ' On colorie les cellules en bleu
    End With
 
    ' On crée le plan en fonction du niveau hiérarchique des tâches défini dans MS Project
    For j = 1 To Tcount
        For i = 3 To .Cells(65536, 1).End(xlUp).Row
            If .Cells(i, 11).Value >= j Then .Cells(i, 1).Rows.Group
        Next i
    Next j
 
    DerLig = .Cells(65536, 1).End(xlUp).Row
    .Activate
    .Range(Cells(3, 11), Cells(DerLig, 11)).Delete ' On efface les données de niveau hierarchique
    DebLigCopy = WkSh.Cells(65536, 1).End(xlUp).Row + 1
    .Cells.Font.Size = 8    ' On définit la taille des caractères dans toutes les cellules de la feuille
 
    .Rows("3:" & DerLig).Copy        ' On copie les cellules issues de MSP Project
    WkSh.Activate
    ' On colle les cellules dans la feuille contenant le planning GFE correspondant
    WkSh.Cells(DebLigCopy, 1).PasteSpecial _
                                            Paste:=xlPasteAll, _
                                            Operation:=xlNone, _
                                            SkipBlanks:=False, _
                                            Transpose:=False
 
End With
 
pj.Quit
DoEvents
 
Set pj = Nothing
Set TmpSh = Nothing
 
End Sub
Sub dwn(Sh As Worksheet, i As Integer)
 
Set xlCell = Sh.Cells(65536, 1).End(xlUp).Offset(i, 0)
 
End Sub
 
Sub rgt(i As Integer)
 
Set xlCell = xlCell.Offset(0, i)
 
End Sub

Quelqu'un aurait-il une idée ? Je désespère ...

**Godzestla** · 11/06/2012, 10h16

Rebonjour,

diificile à dire sans pouvoir tester.

je tenterai différentes choses personnellement :

1)

Code :

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

Pj.close

ou équivalent avant pj.quit

2) vérifier que c'est bien le projet voulu qui est actif.

3) Lister (debug.print,...) les taches du projet pour vérif

4) mettre un délai d'attente quand on ferme le projet no 1 et qu'on quitte MS-Project.

Code :

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

       Application.Wait (Now + TimeValue("0:00:10"))

**JonesKCD** · 11/06/2012, 10h18

J'ai fini par trouver une solution à mon problème.
Pour ceux que ça intéresse, j'ai fait précéder l'appel "ActiveProject.Tasks" par la variable objet "pj", ce qui donne "pj.ActiveProject.Tasks".

J'ai également supprimer le code de fermeture de l'application MS Project à la fin du traitement du fichier. L'application (ainsi que les fichiers ouverts) ne sera fermée qu'en sortie de boucle afin d'accélerer le traietement du code.

Ci-après mon code complet :

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
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
Option Explicit
Dim xlCell As Excel.Range
 
Sub Import_from_Suppliers_Entries()
Dim ThisWk      As Workbook
Dim Rep1        As Integer
Dim Rep2        As Integer
Dim objShell    As Object
Dim objFolder   As Object
Dim oFolderItem As Object
Dim Chemin      As String
Dim Fichier     As String
 
Set ThisWk = ThisWorkbook
 
Rep1 = MsgBox("Souhaitez-vous mettre à jour toutes les données du périmètre", vbYesNoCancel, "Mise à jour des données")
If Rep1 = vbYes Then
    Rep2 = MsgBox("ATTENTION : Les données antérieures seront toutes supprimées." & vbCrLf _
            & " Souhaitez-vous procéder à cette mise à jour ?", _
            vbYesNo + vbExclamation, _
            "Confirmation de la mise à jour des données")
    If Rep2 = vbYes Then
        Set objShell = CreateObject("Shell.Application")
        Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
 
        On Error Resume Next
        Set oFolderItem = objFolder.Items.Item
        Chemin = oFolderItem.Path
 
        If Chemin = "" Then
            MsgBox "Vous n'avez sélectionné aucun répertoire." & vbCrLf _
                    & "Le programme de mise à jour ne peut pas s'éxecuter.", _
                    vbInformation
            Exit Sub
        Else
 
            Application.ScreenUpdating = False
 
            ' On supprime les données éventuellement présente sur la feuille
            If ThisWk.ActiveSheet.UsedRange.Rows.Count >= 13 Then
                ThisWk.ActiveSheet.Range(Cells(13, 1), Cells(ThisWk.ActiveSheet.UsedRange.Rows.Count, 1)).EntireRow.Delete
            End If
            Chemin = Chemin & "\"
            Fichier = Dir(Chemin & "*.mpp") ' On boucle sur tous les fichiers MS Project
            Do While Len(Fichier) > 0
                Extract_MSP ThisWk.ActiveSheet, Chemin, Fichier
                Fichier = Dir()
            Loop
 
            On Error Resume Next
            GetObject(, "MSProject.Application").Quit savechanges:=pjDoNotSave  ' On ferme MS Project si l'application est ouverte
 
            Application.ScreenUpdating = True
 
        End If
    Else
        Exit Sub
    End If
 
    Set oFolderItem = Nothing
    Set objFolder = Nothing
    Set objShell = Nothing
 
End If
 
Set ThisWk = Nothing
 
End Sub
 
Sub Extract_MSP(WkSh As Worksheet, Rep As String, FichMSP As String)
Dim t           As Task
Dim pj          As MSProject.Application
Dim DerLig      As Long
Dim DebLigCopy  As Long
Dim xlApp       As Excel.Application
Dim xlBook      As Excel.Workbook
Dim xlSheet     As Excel.Worksheet
Dim Asgn        As Assignment
Dim ColumnCount As Integer
Dim Columns     As Integer
Dim Tcount      As Integer
Dim TmpSh       As Worksheet
Dim i           As Integer
Dim j           As Integer
 
Set TmpSh = ThisWorkbook.Sheets("Template")
' On vérifie si MSP n'est pas déjà ouvert
On Error Resume Next
Set pj = GetObject(, "MSProject.Application")
On Error GoTo 0
If pj Is Nothing Then
    Set pj = CreateObject("MSProject.Application")
End If
 
pj.FileOpen Rep & FichMSP, ReadOnly:=True
pj.Visible = True   ' On affiche la fenêtre MS Project
DoEvents
 
With TmpSh
    DerLig = .Cells(65536, 1).End(xlUp).Row + 1
    If DerLig >= 3 Then .Rows(3 & ":" & DerLig).Delete
 
    Tcount = 0
    For Each t In pj.ActiveProject.Tasks
        If Not t Is Nothing Then
            dwn TmpSh, 1
            xlCell = t.Name
            If t.Summary = False Then
                rgt 2
                xlCell = t.Duration
                rgt 1
                xlCell = t.Start
                rgt 2
                xlCell = t.Finish
                rgt 2
                If t.PercentComplete > 0 And t.PercentComplete <> "" Then
                    xlCell = Format(t.PercentComplete / 100, "0%")
                End If
                rgt 3
                xlCell = t.OutlineLevel
                If t.OutlineLevel > Tcount Then Tcount = t.OutlineLevel
            Else
                rgt 10
                xlCell = t.OutlineLevel
            End If
        End If
    Next t
 
    .Columns(4).NumberFormat = "dd/mm/yy;@"     ' On force le contenu des cellules au format date
    .Columns(6).NumberFormat = "dd/mm/yy;@"
 
    ' On ajoute une ligne permettant d'identifier la source des données
    .Rows(3).Insert Shift:=xlDown
    With .Cells(3, 1)
        .Value = FichMSP                        ' On saisit le nom du fichier source MS Project
        .Font.Bold = False                      ' On supprime la mise en gras de la cellule
        .HorizontalAlignment = xlLeft           ' On aligne les caractères à gauche dans la cellule
        .Resize(1, 11).Interior.ColorIndex = 37 ' On colorie les cellules en bleu
    End With
 
    ' On crée le plan en fonction du niveau hiérarchique des tâches défini dans MS Project
    For j = 1 To Tcount
        For i = 3 To .Cells(65536, 1).End(xlUp).Row
            If .Cells(i, 11).Value >= j Then .Cells(i, 1).Rows.Group
        Next i
    Next j
 
    DerLig = .Cells(65536, 1).End(xlUp).Row
    .Activate
    .Range(Cells(3, 11), Cells(DerLig, 11)).Delete ' On efface les données de niveau hierarchique
    DebLigCopy = WkSh.Cells(65536, 1).End(xlUp).Row + 1
    .Cells.Font.Size = 8    ' On définit la taille des caractères dans toutes les cellules de la feuille
 
    .Rows("3:" & DerLig).Copy        ' On copie les cellules issues de MSP Project
    WkSh.Activate
    ' On colle les cellules dans la feuille contenant le planning GFE correspondant
    WkSh.Cells(DebLigCopy, 1).PasteSpecial _
                                            Paste:=xlPasteAll, _
                                            Operation:=xlNone, _
                                            SkipBlanks:=False, _
                                            Transpose:=False
 
End With
 
Set pj = Nothing
Set TmpSh = Nothing
 
End Sub
Sub dwn(Sh As Worksheet, i As Integer)
 
Set xlCell = Sh.Cells(65536, 1).End(xlUp).Offset(i, 0)
 
End Sub
 
Sub rgt(i As Integer)
 
Set xlCell = xlCell.Offset(0, i)
 
End Sub

**Godzestla** · 11/06/2012, 10h32

j'ai fait précéder l'appel "ActiveProject.Tasks" par la variable objet "pj", ce qui donne "pj.ActiveProject.Tasks".

Bien évidement.

Cela m'avait complètement échappé.

Désolé.

Cela est valable pour toute application tierce pilotée par Excel.

Bien vu.

Importation MS Project dans Excel [XL-2003]

Macros et VBA Excel

Discussions similaires

Partager

Partager