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 de mes variables publiques
Public IDMigration As Integer
Public IDBuild As Integer
Public IDRun As Integer
Sub ImportTachesExcel()
'Constantes
COL = 5
'Variables
Dim CurrentID As Long
Dim cpt As Integer
Dim cpt2 As Integer
Dim chrono As Integer
Dim Rubrique As String
Dim pathxls As String
Dim trouvé As Boolean
Dim Xlobj As Object
Dim Xlsht As Object
Dim i As Integer
Dim vrow As Integer
Dim Position
'Traitement de l'erreur
On Error Resume Next
'Instanciation des variables
pathxls = "" 'mettre le chemin du fichier excel
'Recheche de l'ID de chaque rubrique : Build, Migration, Run
refreshid
'Creation de l'objet Excel
Set Xlobj = CreateObject("Excel.Application")
'Ouverture du fichier
Xlobj.workbooks.Open pathxls
'Scanning des lignes et comparaison avec les taches Project afin d'insérer celles qui ne sont pas présentes
' Pierre de Rosette = Numéro Chrono stocké dans le champ project : Numéro 1
cpt = 2
While Xlobj.Worksheets("Basedonnées").cells(cpt, 1) <> ""
'Parcours du fichier afin de voir si le chrono est existant dans le project
chrono = Xlobj.Worksheets("Basedonnées").cells(cpt, 1)
'Rubrique = UCase(Xlobj.Worksheets("Basedonnées").cells(cpt, 4))
Rubrique = Xlobj.Worksheets("Basedonnées").cells(cpt, 4)
trouvé = False
For cpt2 = 1 To ActiveProject.Tasks.Count
If chrono = ActiveProject.Tasks(cpt2).Number1 Then
trouvé = True
End If
Next cpt2
'Traitement si pas trouvé, on insère dans la sous rubrique correspondante (Build, Run, Migration)
If trouvé = False Then
'Instanciation de l'ID sous lequel créer la tache
Select Case Rubrique
Case "BUILD"
CurrentID = IDBuild
Case "Migration"
CurrentID = IDMigration
Case "RUN"
CurrentID = IDRun
End Select
'Création de la tache
ActiveProject.Tasks.Add "my new task", CurrentID + 1
'ActiveProject.Tasks(idtask).Parent = CurrentID
'ActiveProject.Tasks(idtask).Ressources.Add Xlobj.Worksheets("Basedonnées").cells(cpt, 9)
'ActiveProject.Tasks(idtask)
'Xlobj.Worksheets("Basedonnées").cells(cpt, 5), CurrentID
'Appel de la fonction pour retrouver les bons id de positionnement
refreshid
End If
cpt = cpt + 1
Wend
Xlobj.Quit
Set Xlobj = Nothing
End Sub
'Fonction de recherche de l'id avant et après insertion de tâches
Sub refreshid()
On Error Resume Next
Dim cpt As Integer
For cpt = 1 To ActiveProject.Tasks.Count
Select Case ActiveProject.Tasks(cpt).Name
Case "Migration"
IDMigration = ActiveProject.Tasks(cpt).ID
Case "RUN"
IDRun = ActiveProject.Tasks(cpt).ID
Case "BUILD"
IDBuild = ActiveProject.Tasks(cpt).ID
End Select
Next cpt
End Sub |
Partager