Bonjour à tous,

voilà je me tourne vers vous car je rencontre un petit souci dans mon code.
En effet, j'ai mis au point une macro qui compare les lignes d'un fichier Excel contenant une liste de tâche avec un fichier Project.
J'arrive à bien comparer mes deux fichiers, mais le problème est que lorsque par exemple mon code ne retrouve pas une tâche présente dans mon project dans le fichier excel celui-ci devrait me rajouter la tâche project dans Excel.
Le problème est que lorsque la condition trouvé est False, mon code saute automatiquement toute la partie du code qui est censé copié ma tâche dans mon fichier Excel
Je suis un peu perdu et toute aide ou conseil serait le bien venu

Cordialement,

Miguel

Pour y voir plus claire voici mon code ci dessous :

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
'Déclaration constantes
Const COL = 7
 
'Compare fichier existant avant extraction
Sub Compare()
 
'Instanciation variable
Dim ProjObj As MSProject.Application
Dim T As Tasks
Dim path
Dim tache
Dim find As Boolean
Dim vrow As Integer
Dim vrowex As Integer
 
 
'Création d'un objet Project (Permet le pilotage de Project depuis Excel)
Set ProjObj = CreateObject("msproject.application")
 
 
'Ouvre une boîte de dialogue demandant à l'user de choisir son fichier Project
Fichier = Application.GetOpenFilename("Fichiers .MPP(*.mpp),*.mpp")
If Fichier = False Then Exit Sub
 
    'Ouverture du fichier Project pour Extraction vers Excel
    ProjObj.FileOpen Fichier, _
    ReadOnly:=True
 
    'Affiche ou non le fichier Project
    ProjObj.Visible = False
 
 
'Ouvre le fichier excel à comparer avec le project
path = Application.GetOpenFilename("Fichiers .XLS (*.xls),*.xls, Fichiers .XLSX(*.xlsx),*.xlsx,Fichiers .XLSM (*.xlsm),*.xlsm")
If path = False Then Exit Sub
 
'Ouverture du fichier Excel
Workbooks.Open path
 
    'Affiche ou non le fichier Excel
    'Worksheets.Visible = False
 
vrowex = 2
'Parcours le tableau tant qu'une cellule de la première colonne n'est pas vide
While Worksheets("Extract de Project").Cells(vrowex, 1) <> ""
 
find = False
    For vrow = 1 To ProjObj.ActiveProject.Tasks.Count
'Parcours du fichier afin de voir si la tâche est existante dans le fichier Excel
        tache = Worksheets("Extract de Project").Cells(vrowex, 1)
        If tache = ProjObj.ActiveProject.Tasks(vrow).Name Then
            find = True
        End If
 
    vrowex = vrowex + 1
    Next vrow
 
        If find = False Then
        'Copie la nouvelle tâche au bon endroit
 
        With ActiveProject
        SelectRow Row:=vrow - 1
        EditCopy
        End With
 
        Worksheets("Extract de Project").Paste Destination:=Range(Cells(vrowex, 1), Cells(vrowex, 1))
        End If
Wend
 
 
 
'Fermer fichier Project après comparaison
On Error Resume Next
Set Fichier = GetObject(, "MSProject.Application")
If Fichier Is Nothing Then
MsgBox "Project est fermé"
Else
'MsgBox "Project est ouvert"
 
'Fermeture application Project
Fichier.Quit (False)
 
'Libère la mémoire où est stocké l'objet project
Set ProjObj = Nothing
Set Fichier = Nothing
 
End If
 
'Fermeture et sauvegarde fichier Excel
ActiveWorkbook.Save
ActiveWorkbook.Close
 
Application.ScreenUpdating = False
 
 
End Sub