Discussion :

[j.pitou]

Bonjour à tous,

J’ai besoin de développer un outil (macro excel 2007) qui a pour but de faire une comparaison de 2 extractions MS Project d'un même projet, à des dates différentes, pour analyser et lister les différences comme le fait la nouvelle fonctionnalité de MS Project 2010.
Les projets actuellement gérés étant uniquement compatible MS Project 2007 (pas d'export/import possible vers 2010 car corruption des données).

Il faut donc développer cette "moulinette", en VBA -> excel.

En pseudo-code et fonctionnellement le besoin est le suivant :

I. Ouvrir un nouveau fichier excel (.xls) pour « acceuillir le résultat » du suivi spécifique à 1 projet.

II. Lancer une macro dans ce fichier qui va :
A. Demander à l'utilisateur de choisir le fichier 1 de comparaison (le plus ancien) sur le disque
B. demander à l'utilisateur de choisir le fichier 2 de comparaison (le plus récent) sur le disque

III. Reconstruire sur le fichier de suivi l'intégralité du plan Project combiné issu de la comparaison des 2 fichiers (cf. modele visuel et maquete excel en fichiers attachés)


Pour reconstruire le fichier comme ci-dessus, j’ai pour l’instant cette macro :

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
 
 
Sub OS2P()
 
    Dim FichierAncient As String
    Dim FichierRecent As String
 
    Application.ScreenUpdating = False
    Application.StatusBar = "Creation du rapport..."
 
    MsgBox "Veuillez ouvrir le fichier le plus ancient"
    Application.Dialogs(xlDialogOpen).Show
    FichierAncient = ActiveWorkbook.Name
 
    MsgBox "Veuillez ouvrir le fichier le plus récent"
    Application.Dialogs(xlDialogOpen).Show
    FichierRecent = ActiveWorkbook.Name
 
 
    Dim iLRA%, iLRN%, i%, j%, k%
    Dim Y As Boolean, Ys As Boolean
    Dim TabloA(), TabloN()
    Dim WbA As Workbook, WbN As Workbook, WbOS2P As Workbook
    Dim WsA As Worksheet, WsN As Worksheet, WsOS2P As Worksheet
 
    'Détermination du nombre de ligne de Classeur "Ancien" et "Recent"
    Set WbA = Workbooks(FichierAncient)
    Set WbN = Workbooks(FichierRecent)
 
    Set WsA = WbA.Worksheets(1)
    Set WsN = WbN.Worksheets(1)
 
    iLRA = WsA.Cells(65535, 1).End(xlUp).Row
    iLRB = WsN.Cells(65535, 1).End(xlUp).Row
    TabloA() = WsA.Range("A1:A" & iLRA)
    TabloN() = WsN.Range("A1:A" & iLRB)
 
    'Détermination des absents
    For i = 1 To UBound(TabloA)
      For j = 1 To UBound(TabloN)
 
        'Si égalité alors on pose un drapeau
        If TabloN(j, 1) = TabloA(i, 1) Then
          Y = True
          'et on vérifie la ligne si c'est une égalité stricte
            For k = 1 To 15
              'si différence on pose un drapeau
              If WsA.Cells(i, k) <> WsN.Cells(j, k) Then
                Ys = True
                'et on colore en orange
                WsN.Cells(j, k).Interior.ColorIndex = 45
              End If
 
                Next
              'sinon 1ere cellule en vert
                If Not Ys Then WsN.Cells(j, 1).Interior.ColorIndex = 4
                    Ys = False
            Exit For
        End If
      Next
      'Si pas trouvé alors on colorie en rouge
      If Not Y Then WsA.Range("A" & i).Interior.ColorIndex = 3
      Y = False
    Next
 
    Set WbA = Nothing
    Set WbN = Nothing
    Set WsA = Nothing
    Set WsN = Nothing
 
    Groupes
 
End Sub
 
Sub Groupes()
    Cells.Select
    Selection.ClearOutline
    Range("A2").Select
    While ActiveCell.Value <> ""
        i = 1
        For j = 2 To ActiveCell.Offset(0, 15).Value
            ActiveCell.Value = "   " + ActiveCell.Value
        Next j
        Var_Range = ActiveCell.Offset(1, 0).Address
        While ActiveCell.Offset(i, 15).Value > ActiveCell.Offset(0, 15).Value
            i = i + 1
        Wend
        If i > 1 Then
            Range(ActiveCell.Offset(1, 15).Address + ":" + ActiveCell.Offset(i - 1, 15).Address).Select
            Selection.Rows.Group
        End If
        Range(Var_Range).Select
    Wend
    With ActiveSheet.Outline
        .AutomaticStyles = False
        .SummaryRow = xlAbove
        .SummaryColumn = xlRight
    End With
End Sub

Mes problèmes sont les suivant :
- Je n'arrive pas à effectuer une comparaison entre les 2 fichiers pour savoir si il y a un ajout ou une suppresion.
- J'aimerais copié les lignes qui sont supprimer du fichier "ancient" dans le fichier "récent"
- J'aimerais ajouté une colonne tout à gauche dans le fichier "récent" qui marque les lignes avec A (ajout) M (modif) et S(supprimer) comme dans l'image ci-dessus => ce que j'ai essayé de faire créer un décalage dans les colonnes...

Mes 2 fichiers "tests" sont joints également.

Je vous remercie énormément d'avance pour votre aide sur le sujet !

Cordialement,
Julien