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 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313
| Public Sub CorpsPlanning()
'dessine le corps du planning
' --------------------------------------------------------------------------------------
' DECLARE LES VARIABLES VACANCES, TARIFS et DEMANDES-RESERVATIONS
' -------------------------------------------------------------------------------------
' SPECIFICATION -Communes
Dim cdb As DAO.Database
Dim debutZoneVacances As Long ' début de l'affichage de la zone VACANCES
Dim debutZoneSaison As Long ' début de l'affichage de la zone TARIFS/SAISON
Dim debutZoneDemande As Long ' début de l'affichage de la zone DEMANDES/RESERVATIONS
Dim lignesVacances As Long ' nombre de lignes VACANCES affichées
Dim lignesSaison As Long ' nombre de lignes TARIFS/SAISON affichées
Dim lignesDemande As Long ' nombre de lignes DEMANDES/RESERVATIONS affichées
Dim totLignesPlanning As Long ' nombre de lignes TOTAL affichées sur le planning
Dim htRow As Long ' HtRow = hauteur de la ligne
Dim htRowSaison As Long
Dim yRow As Long ' YRow = coordonnée Y début de la ligne
Dim yhRow As Long ' YhRow = coordonnée Y haute de la ligne décalé
Dim ybRow As Long ' YbRow = coordonnée Y basse de la ligne décalé
Dim I As Integer, J As Integer, K As Integer, k1 As Integer, L As Integer
Dim td As Long, Xg As Long, Xd As Long, Yh As Long, Yb As Long, ep As Long
Dim zoomVerPla As Single
' INITIALISE l'Affichage des Vacances
Dim xLine As Integer 'regroupe X lignes sur l'image des vacances
' INITIALISE l'Affichage du tarif
Dim gt_Tl() As Long ' tableau qui enregistre les lignes tarifs
' oPlanning.MinTextSize = 7
' oPlanning.MaxTextSize = 11
' INITIALISE l'Affichage du Planning
Dim nLog As Long, nRes As Long, pTar As Double
Dim Ligne1 As Long
Dim nL As Long
Dim chifAliVer As Long, chifCouFond As Long, chifCouTxt As Long
Dim chifTotal As Single, chifTotalCompare As Single
Dim intColDateReg As Integer
Dim xDem1 As Long, YDem1 As Long, xOpt1 As Long, xCon1 As Long, xRes1 As Long, xLin As Long
Dim xDem2 As Long, xOpt2 As Long, xCon2 As Long, xRes2 As Long
Dim coul As Long ' couleurs diverses
Dim strTxtReg As String
Dim lregion As String
Dim strTitre1 As String, strTitre2 As String, strTitre3 As String
Dim aDate As Date ' date d'aujourd'hui mais pour une année différente.
Static sRegDoublon As Integer
' -------------------------------------------------------------------------------------
' FIN DES VARIABLES
' -------------------------------------------------------------------------------------
MajFrmPlanning
lngCouFonEntete = vbWhite
lngCouTxtEntete = vbBlue
' -------------------------------------------------------------------------------------
' INITIALISATION des coordonnée image
' -------------------------------------------------------------------------------------
totLignesPlanning = 0
lignesDemande = 0
zoomVerPla = 1 + Round(((g_ZoomVerPla) / 10), 1)
ep = 4 ' épaisseur trai vertical date demande solde
Set cdb = CurrentDb
If g_LogSsTar Then
lignesSaison = DCount("Idlog", "T_Logement", "Aff = True")
Else
lignesSaison = DCount("Idlog", "R_TarifCount")
End If
' le yBas dimensionne la hauteur de l'image pour que les infos soient visibles entièrement
If g_ZoneVacance Then
debutZoneVacances = 1
lignesVacances = m_LignesVacances
strTitre1 = "Vacances"
If g_ZoneSaison Then
g_Separation1 = debutZoneVacances + lignesVacances
debutZoneSaison = g_Separation1 + 1
g_Separation2 = g_Separation1 + lignesSaison + 1
debutZoneDemande = g_Separation2 + 1
strTitre2 = "Tarifs"
strTitre3 = "Planning"
Else
g_Separation1 = 0
debutZoneSaison = 0
lignesSaison = 0
g_Separation2 = debutZoneVacances + lignesVacances
debutZoneDemande = g_Separation2 + 1
strTitre3 = "Planning"
End If
Else
lignesVacances = 0
g_Separation1 = 0
If g_ZoneSaison Then
debutZoneSaison = 1
g_Separation2 = debutZoneSaison + lignesSaison
debutZoneDemande = g_Separation2 + 1
strTitre1 = "Tarifs"
strTitre3 = "Planning"
Else
lignesSaison = 0
g_Separation2 = 0
debutZoneDemande = 1
strTitre1 = "Planning"
End If
End If
' -------------------------------------------------------------------------------------
' SPECIFICATIONS DE L'IMAGE PLANNING
' -------------------------------------------------------------------------------------
If g_SupLigne Then SupprimeLigne 'enleve les lignes vides superflues sur le planning.
g_SupLigne = True
' compte le nombre de lignes qui seront affichées au planning pour dimensionner l'image.
' -------------------------------------------------------------------------------------
' planning des demandes et des réservations
If Forms!F_Planning.Form.chkReglement = False Then
' affiche les demandes et les réservations sur le planning.
If g_SqlReservation = vbNullString Then
strSql = _
"SELECT Sum(R2.MaxDeLigneLog) AS SommeDeAffLigne " & _
"FROM (" & _
"SELECT Max(R1.LigneLog) AS MaxDeLigneLog " & _
"FROM (" & _
"SELECT R_Reservation.IIdLog, R_Reservation.LigneLog " & _
"From R_Reservation " & _
"WHERE (((R_Reservation.DateA) <" & g_DateFinUs & ") " & _
"And ((R_Reservation.DateF) >" & g_DateDebutUs & ") " & _
"And ((R_Reservation.Archive) = False) " & _
"And ((R_Reservation.Aff) = True)) " & _
"ORDER BY R_Reservation.IIdLog, R_Reservation.LigneLog) " & _
"as R1 " & _
"GROUP BY R1.IIdLog) " & _
"as R2;"
' affiche que les réservations sur le planning.
Else
strSql = _
"SELECT Sum(R2.AffLigne) AS SommeDeAffLigne " & _
"FROM ( " & _
"SELECT T_Logement.IdLog, T_Logement.AffLigne " & _
"From T_Logement " & _
"WHERE (((T_Logement.Aff) = True)) " & _
"GROUP BY T_Logement.IdLog, T_Logement.AffLigne) as R2;"
End If
Set rsPl = cdb.OpenRecordset(strSql, dbOpenDynaset)
If rsPl.EOF Then
lignesDemande = 0
Else
rsPl.MoveLast
lignesDemande = Nz(rsPl!SommeDeAffLigne, 0)
End If
' planning des règlements
Else
strSql = "SELECT T_Reservation.IdRes, T_Reservation.DateA, T_Reservation.DateF, T_Logement.Aff, T_Reservation.Reserve " & _
"FROM T_Logement INNER JOIN (T_Reservation INNER JOIN T_ReservationLogement ON T_Reservation.IdRes = T_ReservationLogement.IIdRes) " & _
"ON T_Logement.IdLog = T_ReservationLogement.IIdLog " & _
"WHERE (((T_Reservation.DateA)<" & g_DateFinUs & ") " & _
"And ((T_Reservation.DateF)>" & g_DateDebutUs & ") " & _
"And ((T_Reservation.Reserve)=True)" & _
"And ((T_Logement.Aff)=True));"
Set rsPl = cdb.OpenRecordset(strSql, dbOpenDynaset)
If rsPl.EOF Then
lignesDemande = 0
g_RowHeightPlanning = 24 'augmente la hauteur de ligne du planning des règlement au niveau du planning des demandes/réservations par défault [8] pour afficher le texte "Vide !"
Else
rsPl.MoveLast
lignesDemande = Nz(rsPl.RecordCount, 0)
End If
End If
If lignesDemande = 0 Or DCount("IIdlog", "R_saison") = 0 Then
lignesDemande = 1
g_Vide = True
Else
g_Vide = False
End If
' hauteurs de ligne du planning
' -------------------------------------------------------------------------------------
' HtUnit = 6
' HtCalMois = 3.5 * HtUnit ' 21 px hauteur du calendrier des mois
' HtCalSemaine = 1.5 * HtUnit + 1 ' 9 px hauteur du calendrier des jours ' [ + 1] :: modif du [11/01/2019 10:14:37] pour que le cadre des cumuls passe sous la date samedi
' HtSeps = 2 * HtUnit ' 12 px, à 0 lors du premier passage, puis initialisé en fin de boucle. Hauteur de séparation des zones du planning
htUnit = 3
htCalMois = 7 * htUnit ' 21 px hauteur du calendrier des mois
htCalSemaine = 4 * htUnit ' 12 px hauteur du calendrier des jours ' [ + 1] :: modif du [11/01/2019 10:14:37] pour que le cadre des cumuls passe sous la date samedi
htSeps = 4 * htUnit ' 12 px, à 0 lors du premier passage, puis initialisé en fin de boucle. Hauteur de séparation des zones du planning
' Décalage lignes 'horaire
' -------------------------------------------------------------------------------------
g_dhS = 0 ' Décalage haut lignes Saison
g_dbS = g_htBandeJour * zoomVerPla ' Décalage bas lignes Saison
g_dhR = 0 ' Décalage haut lignes Saison
g_dbR = g_htBandeJour * zoomVerPla ' Décalage bas lignes Saison
g_dbP = g_htBandeJour * zoomVerPla ' Décalage haut lignes Promotion
g_dhP = (24 - g_htBandeJour) / 2 ' Décalage bas lignes Promotion
totLignesPlanning = g_Separation2 + lignesDemande
J = 0
g_RowHeightVac = 12
If g_AffTxtTarif = 1 Then
htRowSaison = (30 * zoomVerPla)
Else
htRowSaison = ((18 + g_RowHeightPro) * zoomVerPla)
End If
yhRow = 0
ybRow = 0
yCal = 0
yMois = 0
ySemaine = 0
yHaut = 0: yBas = 0: g_htPla = 0
If g_Compare And g_Chiffre Then
totLignesPlanning = totLignesPlanning + lignesDemande + 2
ElseIf g_Compare Then
totLignesPlanning = totLignesPlanning + lignesDemande
ElseIf g_Chiffre Then
totLignesPlanning = totLignesPlanning + 1
End If
ReDim gt_Rows(1 To 8, 0 To totLignesPlanning + 1)
ReDim gt_Reg(1 To 3, 0 To totLignesPlanning + 1)
Do While J <= totLignesPlanning + 1 ' + 1 :: Crée une ligne en plus en dessous du planning
' pour permettre de décaler la demande de la dernière
' ligne du planning à la ligne du dessous.
If J = 0 Then
yRow = 0
htRow = htCalMois + htCalSemaine
yCal = 0
yMois = htCalMois
ySemaine = htCalMois + htCalSemaine
yhRow = 0
ybRow = htCalMois + htCalSemaine
' ------------------------------------
' zone vacances
' ------------------------------------
ElseIf J >= Nz(debutZoneVacances, 0) And J < Nz(debutZoneVacances + lignesVacances, 0) Then
htRow = g_RowHeightVac * (1 + (zoomVerPla - 1) / 2) '12 '+ g_RowHeightVac
yhRow = yRow
ybRow = htRow + yRow
' ligne séparation 1 -------------------------------------------------------
ElseIf J = Nz(g_Separation1, 0) Then
htRow = htCalMois + htCalSemaine + htSeps
yCal = yRow + htSeps
yMois = yCal + htCalMois
ySemaine = yMois + htCalSemaine
yhRow = yRow
ybRow = htRow + yRow
' ------------------------------------
' zone saison
' ------------------------------------
ElseIf J >= Nz(debutZoneSaison, 0) And J < Nz(debutZoneSaison + lignesSaison, 0) Then
htRow = htRowSaison
yhRow = yRow + g_dhS ' haut décalé
ybRow = htRow + yRow - g_dbS ' bas décalé
' ligne séparation 2 -------------------------------------------------------
ElseIf J = Nz(g_Separation2, 0) Then
htRow = htCalMois + htCalSemaine + htSeps
yCal = yRow + htSeps
yMois = yCal + htCalMois
ySemaine = yMois + htCalSemaine
yhRow = yRow
ybRow = htRow + yRow
' ------------------------------------
' zone demande / réservation
' ------------------------------------
ElseIf J > Nz(g_Separation2, 0) Then
htRow = g_RowHeightPlanning * zoomVerPla - (g_Chiffre And Not g_Compare) * 5
yhRow = yRow + g_dhR ' haut décalé
ybRow = htRow + yRow - g_dbR ' bas décalé
End If
gt_Rows(1, J) = yRow ' haut de la ligne
yRow = yRow + htRow ' hauteur de la ligne
gt_Rows(2, J) = yRow ' bas de la ligne
gt_Rows(3, J) = yhRow ' haut décalé de la ligne
gt_Rows(4, J) = ybRow ' bas décalé de la ligne
gt_Rows(5, J) = yCal ' haut de la ligne Mois, début du calendrier
gt_Rows(6, J) = yMois ' bas de la ligne Mois ou haut de la ligne Semaine
gt_Rows(7, J) = ySemaine ' bas de la ligne Semaine
' capte la ligne où le cadre-info max ht(170 Px) peut être affiché vers le haut
If yHaut = 0 Then
If gt_Rows(1, J) + 14 > 175 Then '
yHaut = gt_Rows(1, J) ' ligne J où le cadre-info peur s'afficher entier vers le haut
yBas = gt_Rows(2, J) + 175 ' ht mini image planning pour que la ligne J affiche le cadre vers le bas
End If ' en fait il y aura une ligne de plus au planning
End If
J = J + 1
Loop
g_xelip = CLng(((g_RowHeightPlanning - g_htBandeJour) * zoomVerPla) / 1.5)
g_yelip = g_xelip |
Partager