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 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142
| Public Sub MajPlanning()
On Error GoTo Err_MajPlanning
Dim i As Integer, j As Integer, k As Integer
Dim NEmp As Integer
Dim sql1 As String
Dim AColor As Long, nc As Integer
Dim Col1 As Integer, Col2 As Integer
Dim RecPL As DAO.Recordset
Dim Tache As String
Dim Qry As DAO.QueryDef
Set Qry = CurrentDb.QueryDefs("R_Vacation2")
Qry.Parameters("[Formulaires]![fPlanning]![Equipe]") = Forms!fPlanning!Equipe
Set RecPL = Qry.OpenRecordset
InitPlanning
RecPL.MoveFirst
i = 1
j = 0
k = 0
Do While Not (RecPL.EOF)
If RecPL!fonction = "CME" Then
obPlanning.DrawFieldText i, 1, RecPL!Nom_tech, 10, 0, 1, 6316128
ElseIf RecPL!fonction = "EIR" Then
obPlanningEIR.DrawFieldText j, 1, RecPL!Nom_tech, 10, 0, 1, 6316128
ElseIf RecPL!fonction = "Manager" Then
obPlanningManager.DrawFieldText k, 1, RecPL!Nom_tech, 10, 0, 1, 6316128
End If
NEmp = RecPL!mat
Do While (RecPL!mat = NEmp)
If Not IsNull(RecPL!Date_vac) Then
AColor = Nz(RecPL!Couleur, 16777215)
If (RecPL!Date_vac < DateDebut + 35) And (RecPL!Date_vac > DateDebut - 1) Then
Tache = RecPL!code
Col1 = ConversionJourVersColonne(RecPL!Date_vac)
If RecPL!fonction = "CME" Then
With obPlanning
.DrawRect i, Col1, i, Col1, AColor, 6316128, 1
.DrawText i, Col1, i, Col1, Tache, 9, 1, 1, vbBlack, False
End With
ElseIf RecPL!fonction = "EIR" Then
With obPlanningEIR
.DrawRect j, Col1, j, Col1, AColor, 6316128, 1
.DrawText j, Col1, j, Col1, Tache, 9, 1, 1, vbBlack, False
End With
ElseIf RecPL!fonction = "Manager" Then
With obPlanningManager
.DrawRect k, Col1, k, Col1, AColor, 6316128, 1
.DrawText k, Col1, k, Col1, Tache, 9, 1, 1, vbBlack, False
End With
End If
End If
End If
RecPL.MoveNext
If (RecPL.EOF) Then
Exit Do
End If
Loop
If Not RecPL.EOF Then
If RecPL!fonction = "CME" Then
i = i + 1
ElseIf RecPL!fonction = "EIR" Then
j = j + 1
ElseIf RecPL!fonction = "Manager" Then
k = k + 1
End If
End If
Loop
obHeader.KeepImage
obHeader.Refresh
obPlanningManager.KeepImage
obPlanningManager.Refresh
obPlanning.KeepImage
obPlanning.Refresh
obPlanningEIR.KeepImage
obPlanningEIR.Refresh
obTotal.KeepImage
obTotal.Refresh
' Libération des variables.
RecPL.Close
Set RecPL = Nothing
Qry.Close
Set Qry = Nothing
Exit_MajPlanning:
Exit Sub
Err_MajPlanning:
Set obHeader = Nothing
Set obPlanningManager = Nothing
Set obPlanning = Nothing
Set obPlanningEIR = Nothing
Set obTotal = Nothing
MsgBox Err.description
Resume Exit_MajPlanning
End Sub |
Partager