VBA Excel --> MsProject

Le 10/09/2022 à 19:34

Bonjour a tous,

Pour ceux qui cherche des bout de codes pour piloter MsProject à partir d'Excel, ayant beaucoup galéré.

La macro recupere les données sur la feuille "Ro_Upgrade"

excel msproject 
Option Explicit 'U_Project

Option Private Module

Dim pjApp As MSProject.Application

Dim I As Integer, P As Integer

Sub NewProject()

' Ouverture Ms project
    Set pjApp = New MSProject.Application
    pjApp.FileNew

' Création des tâches
P = 1

For I = 105 To 119
    pjApp.ActiveProject.Tasks.Add (Worksheets("Ro_Upgrade").Cells(I, 5).Value)
    pjApp.ActiveProject.Tasks(P).Duration = (Worksheets("Ro_Upgrade").Cells(I, 8).Value) * 60
    pjApp.ActiveProject.Tasks(P).Text1 = (Worksheets("Ro_Upgrade").Cells(I, 4).Value)
    pjApp.ActiveProject.Tasks(P).Text2 = (Worksheets("Ro_Upgrade").Cells(I, 8).Value)
    pjApp.ActiveProject.Tasks(P).Estimated = False
    pjApp.ActiveProject.Tasks(P).Manual = False

' Liaisons des tâches
    If I = 106 Then
        pjApp.ActiveProject.Tasks(P).Predecessors = "1DD"
    End If

    If I = 107 Then
        pjApp.ActiveProject.Tasks(P).Predecessors = 2
    End If

    If I = 108 Then
        pjApp.ActiveProject.Tasks(P).Predecessors = "1DD"
    End If

    If I >= 109 And I <= 117 Then
        pjApp.ActiveProject.Tasks(P).Predecessors = "4;3;2"
    End If

    If I = 116 Then ' Embal./ Manut./ Transp.
        pjApp.ActiveProject.Tasks(P).Predecessors = "11;5;6;7;8;9;10"
    End If

    If I = 117 Then
        pjApp.ActiveProject.Tasks(P).Predecessors = "10FF;5FF;7FF;8FF;9FF"
    End If

    If I = 118 Then
        pjApp.ActiveProject.Tasks(P).Predecessors = 12
    End If

    If I = 119 Then
        pjApp.ActiveProject.Tasks(P).Predecessors = 14
    End If

    P = P + 1
Next I

' Démarrage manuel du projet
    pjApp.ActiveProject.Tasks(1).Manual = True

' Date de démarrage
    pjApp.ActiveProject.Tasks(1).Start = "19/09/2022"

' ############a travailler ###########

' Les couleurs de Gantt
' 3506515 MiddleColor:=238746 EndColor:=&H538135
    pjApp.GanttBarFormatEx TaskID:=1, StartColor:=238746, MiddleColor:=238746, EndColor:=238746
    pjApp.GanttBarFormatEx TaskID:=2, StartColor:=5383172, MiddleColor:=5383172, EndColor:=5383172
    pjApp.GanttBarFormatEx TaskID:=3, StartColor:=5383172, MiddleColor:=5383172, EndColor:=5383172
    pjApp.GanttBarFormatEx TaskID:=4, StartColor:=192, MiddleColor:=192, EndColor:=192
    pjApp.GanttBarFormatEx TaskID:=12, StartColor:=16750899, MiddleColor:=16750899, EndColor:=16750899
    pjApp.GanttBarFormatEx TaskID:=13, StartColor:=3381759, MiddleColor:=3381759, EndColor:=3381759
    pjApp.GanttBarFormatEx TaskID:=14, StartColor:=23381606, MiddleColor:=3381606, EndColor:=3381606
    pjApp.GanttBarFormatEx TaskID:=15, StartColor:=26112, MiddleColor:=26112, EndColor:=26112

''''''pjApp.Visible = True

' Création et affichage des colonnes

    pjApp.TableEditEx Name:="&Entrée", TaskTable:=True, NewFieldName:="Text1", _
    Width:=12, AlignTitle:=pjCenter, ShowInMenu:=True, ShowAddNewColumn:=1, Align:=1, AlignTitle:=1, ColumnPosition:=-1
    pjApp.TableApply Name:="&Entrée"

    pjApp.TableEditEx Name:="&Entrée", TaskTable:=True, NewFieldName:="Text2", _
    Width:=12, AlignTitle:=pjCenter, ShowInMenu:=True, ShowAddNewColumn:=1, Align:=1, AlignTitle:=1, ColumnPosition:=-1
    pjApp.TableApply Name:="&Entrée"

    pjApp.TableEditEx Name:="&Entrée", TaskTable:=True, NewFieldName:="Text3", _
    Width:=6, AlignTitle:=pjCenter, ShowInMenu:=True, ShowAddNewColumn:=1, Align:=1, AlignTitle:=1, ColumnPosition:=-1
    pjApp.TableApply "&Entrée"

    pjApp.TableEditEx Name:="&Entrée", TaskTable:=True, NewFieldName:="Text4", _
    Width:=6, AlignTitle:=pjCenter, ShowInMenu:=True, ShowAddNewColumn:=1, Align:=1, AlignTitle:=1, ColumnPosition:=-1
    pjApp.TableApply "&Entrée"

    pjApp.TableEditEx Name:="&Entrée", TaskTable:=True, NewFieldName:="Text5", _
    Width:=10, AlignTitle:=pjCenter, ShowInMenu:=True, ShowAddNewColumn:=1, Align:=1, AlignTitle:=1, ColumnPosition:=-1
    pjApp.TableApply "&Entrée"

    pjApp.TableEditEx Name:="&Entrée", TaskTable:=True, NewFieldName:="Text6", _
    Width:=10, AlignTitle:=pjCenter, ShowInMenu:=True, ShowAddNewColumn:=1, Align:=1, AlignTitle:=1, ColumnPosition:=-1
    pjApp.TableApply "&Entrée"

    pjApp.TableEditEx Name:="&Entrée", TaskTable:=True, NewFieldName:="Text7", _
    Width:=50, AlignTitle:=pjCenter, ShowInMenu:=True, ShowAddNewColumn:=1, Align:=1, AlignTitle:=1, ColumnPosition:=-1
    pjApp.TableApply "&Entrée"

' Rajout des noms sans modifier la struture

    pjApp.SelectTaskColumn Column:="Text1"
    pjApp.CustomFieldRename FieldID:=pjCustomTaskText1, NewName:="Imputation"

    pjApp.SelectTaskColumn Column:="Text2"
    pjApp.CustomFieldRename FieldID:=pjCustomTaskText2, NewName:="Heures RO"

    pjApp.SelectTaskColumn Column:="Text3"
    pjApp.CustomFieldRename FieldID:=pjCustomTaskText3, NewName:="RO"

    pjApp.SelectTaskColumn Column:="Text4"
    pjApp.CustomFieldRename FieldID:=pjCustomTaskText4, NewName:="Ordre SAP"

    pjApp.SelectTaskColumn Column:="Text5"
    pjApp.CustomFieldRename FieldID:=pjCustomTaskText5, NewName:="Chef de projet"

    pjApp.SelectTaskColumn Column:="Text6"
    pjApp.CustomFieldRename FieldID:=pjCustomTaskText6, NewName:="CDE Client"

    pjApp.SelectTaskColumn Column:="Text7"
    pjApp.CustomFieldRename FieldID:=pjCustomTaskText7, NewName:="Suivi"

' Les couleurs des colonnes
    pjApp.SelectTaskColumn Column:="Text1"
    pjApp.Font32Ex CellColor:=15189684

    pjApp.SelectTaskColumn Column:="Text2"
    pjApp.Font32Ex CellColor:=15189684

    pjApp.SelectTaskColumn Column:="Text3"
    pjApp.Font32Ex CellColor:=10092543

    pjApp.SelectTaskColumn Column:="Text4"
    pjApp.Font32Ex CellColor:=10092543

    pjApp.SelectTaskColumn Column:="Text5"
    pjApp.Font32Ex CellColor:=10092543

    pjApp.SelectTaskColumn Column:="Text6"
    pjApp.Font32Ex CellColor:=10092543

    pjApp.SelectTaskColumn Column:="Text7"
    pjApp.Font32Ex CellColor:=10092543

' Supresion affichage
    pjApp.SelectTaskColumn Column:="Prédécesseurs"
    pjApp.ColumnDelete

    pjApp.SelectTaskColumn Column:="Noms ressources"
    pjApp.ColumnDelete

    pjApp.SelectTaskColumn Column:="Text3"
    pjApp.ColumnDelete

    pjApp.SelectTaskColumn Column:="Text4"
    pjApp.ColumnDelete

    pjApp.SelectTaskColumn Column:="Text5"
    pjApp.ColumnDelete

    pjApp.SelectTaskColumn Column:="Text6"
    pjApp.ColumnDelete

    pjApp.SelectTaskColumn Column:="Text7"
    pjApp.ColumnDelete

pjApp.Visible = True

' Enregistrement du planning
pjApp.FileSaveAs ThisWorkbook.Path & "\" & Sheets("Ro_Upgrade").Range("M5") & "_" & Sheets("Ro_Upgrade").Range("G5") & "_" & Sheets("Ro_Upgrade").Range("G7") & "_" & "Planning.mpp"

' -- Document: fermer,quitter,libérer la mémoire et j'en passe :-)
'pjApp.FileClose: pjApp.Quit
Set pjApp = Nothing: Set pjApp = Nothing
End Sub

Note :les "ColumnDelete" --> Un projet général avec les ressources reprend ces sous projets et permet de garder la structure par défaut de Ms Projet.

Reste à travailler les dates ( a partir de demain)

En espérant que cela puis aider

Bien cordialement

Alain

Rechercher des sujets similaires à "vba msproject"