Bonjour
J'essaie désespérément de mettre au point une macro qui permette d'importer de manière automatique les données d'un fichier Excel.
A priori, le code fonctionne, mais n'arrive pas à récupérer les prédécesseurs des tâches.
Je mets de code ci-dessous et joint le fichier Excel pour voir la structure des données.
Si quelqu'un a une idée, merci d'avance.
Sub ImportExcel()
Dim xlApp As Object
Dim xlWorkbook As Object
Dim xlSheet As Object
Dim Project As Project
Dim Task As Task
Dim Row As Integer
Dim Predecessors As String
Dim TaskDict As Object ' Dictionnaire pour stocker les tâches par ID
Dim ResourceDict As Object ' Dictionnaire pour stocker les ressources
' Initialiser les dictionnaires
Set TaskDict = CreateObject("Scripting.Dictionary")
Set ResourceDict = CreateObject("Scripting.Dictionary")
' Chemin vers le fichier Excel
Dim cheminFichierExcel As String
cheminFichierExcel = "V:\PRO\DOCS-ACTES\COMMUNE\Direction-Generale\Planification\Classeur1.xlsx"
' Créer une nouvelle instance d'Excel
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = False ' Rend excel invisible
Set xlWorkbook = xlApp.Workbooks.Open(cheminFichierExcel) ' Ouvre le fichier Excel
Set xlSheet = xlWorkbook.Sheets(1) ' Utilise la première feuille
' Première passe pour parcourir les lignes du fichier Excel et ajouter les tâches dans MS Project
Row = 2 ' La première ligne contient les en-têtes
Do While xlSheet.Cells(Row, 2).Value <> ""
Set Task = ActiveProject.Tasks.Add(xlSheet.Cells(Row, 2).Value)
Task.OutlineLevel = xlSheet.Cells(Row, 2).IndentLevel + 1
TaskDict.Add xlSheet.Cells(Row, 1).Value, Task ' Ajoute dans le dictionnaire des Tâches
Task.Start = xlSheet.Cells(Row, 3).Value
If Int(Task.Start) <> Int(Task.Finish) Then
Task.Finish = xlSheet.Cells(Row, 4).Value
Else
Task.Finish = xlSheet.Cells(Row, 3).Value
End If
Row = Row + 1
Loop
' Deuxième passe pour ajouter les prédécesseurs
Row = 2 ' La première ligne contient les en-têtes
Do While xlSheet.Cells(Row, 2).Value <> ""
If TaskDict.exists(xlSheet.Cells(Row, 1).Value) Then
Set Task = TaskDict(xlSheet.Cells(Row, 1).Value)
Predecessors = xlSheet.Cells(Row, 5).Value
If Predecessors <> "" Then
Dim Preds() As String
Dim i As Integer
Preds = Split(Predecessors, ", ") ' Séparer les prédécesseurs
For i = LBound(Preds) To UBound(Preds)
Dim predID As String
Dim linkType As String
Dim predTask As Task
' Vérifier si la chaîne contient "F"
If InStr(Preds(i), "F") > 0 Then
predID = Left(Preds(i), InStr(Preds(i), "F") - 1) ' Extraire l'ID du prédécesseur
linkType = Mid(Preds(i), InStr(Preds(i), "F"), 2) ' Extraire le type de lien
' Vérifier si la tâche précédente existe
If TaskDict.exists(predID) Then
Set predTask = TaskDict(predID)
' Ajouter la relation entre les tâches
Dim dep As TaskDependency
Set dep = predTask.TaskDependencies.Add(Task)
Select Case linkType
Case "FD": dep.Type = pjFinishToStart ' Fin-Début
Case "DD": dep.Type = pjStartToStart ' Début-Début
Case "FF": dep.Type = pjFinishToFinish ' Fin-Fin
Case "DF": dep.Type = pjStartToFinish ' Début-Fin
End Select
End If
End If
Next i
End If
End If
Row = Row + 1
Loop
' Fermer le fichier Excel
xlWorkbook.Close False
xlApp.Quit
' Libérer les objets
Set xlSheet = Nothing
Set xlWorkbook = Nothing
Set xlApp = Nothing
' Message de confirmation
MsgBox "Importation terminée avec succès !", vbInformation, "Importation Excel"
End SubClasseur1.xlsx
Partager