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 100 101 102 103 104 105 106
|
Private Sub ComboBox1_Change()
Dim startofweek As Date, endofperiod As Date
Dim XLapp As Excel.Application, Xlrange As Excel.Range, Off As Long
Dim appExcel As Excel.Application, dateapp As Excel.Application
Dim wbExcel As Excel.Workbook, i As Integer
Dim wsExcel As Excel.Worksheet, wsExcelBase As Excel.Worksheet
Dim dateDébut As Date, dateFin As Date, xllance As Range, xldate As Range
Dim Tsk As Task, ProjetP As Project, Proj As Project
Dim Path As String, Res As Resource, A As Assignment
Dim TSVS As TimeScaleValues, TSV As TimeScaleValue
Dim prjPCC As Project, PRJ As Project, Nom As Field, finishdate As Date
Me.TextBox1.IntegralHeight = False
Me.TextBox1 = DatSem((CLng(Me.ComboBox1.Text)), CLng(Me.TextBox3.Text)) - 2
TextBox1.Text = Format(TextBox1.Text, "dd mmmm")
Me.TextBox2 = DatSem((CLng(Me.ComboBox1.Text)), CLng(Me.TextBox3.Text)) + 2
TextBox2.Text = Format(TextBox2.Text, "dd mmmm")
'Ouverture de l'application
Set appExcel = GetObject(, "Excel.Application")
'Récupération du classeur par défaut
Set wbExcel = appExcel.ActiveWorkbook
'Récupération de la feuille par défaut
Set wsExcel = wbExcel.ActiveSheet
'création de l'objet range
Set Xlrange = appExcel.Range("c2")
'inscription du N° de semaine sur la feuille excel
Xlrange.Cells(1, 1) = CLng(Me.ComboBox1.Text)
Set xllance = appExcel.Range("d2")
dateDébut = xllance
Set xldate = appExcel.Range("cc1")
Set Xlrange = appExcel.Range("cc4")
startofweek = Date - Weekday(Date) + vbMonday
endofperiod = startofweek + 4
For Off = 0 To 4
xldate.Offset(0, 4 + Off) = dateDébut + Off
Next Off
Set prjPCC = ActiveProject
prjPCC.StartWeekOn = pjMonday
startofweek = dateDébut: endofperiod = dateDébut + 5
For Each Tsk In prjPCC.Tasks
If Not Tsk Is Nothing Then
Path = ActiveProject.Name
Set PRJ = ActiveProject
PRJ.StartWeekOn = pjMonday
For Each Res In PRJ.Resources
If Not Res Is Nothing Then
For Each A In Res.Assignments
If i > 41 Then GoTo sortie
If A.Start <= endofperiod And A.Finish + 1 >= startofweek Then
Xlrange = appExcel.Cells(4, 81)
Xlrange.Offset(0, 2) = Res.Name
Xlrange.Offset(0, 3) = A.TaskName
i = i + 1
Set TSVS = A.TimeScaleData(startofweek, startofweek + 5, pjAssignmentTimescaledWork, pjTimescaleDays)
For Each TSV In TSVS
If TSV.Value <> "" Then
Xlrange.Offset(0, 3 + TSV.Index) = TSV.Value / 60
End If
Next TSV
Set Xlrange = Xlrange.Offset(1, 0)
End If
Next A
End If
Next Res
End If
Next Tsk
sortie:
Unload Me
'MSProject.Quit
End Sub |
Partager