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
|
Sub Rempli_Comase()
If comase.L_CT.ListIndex = -1 Then Exit Sub ' LCT = Liste des animateurs
Dim lct, msg As String
Dim a, i, Ligne, Colonne As Integer
Dim v_date As Date
Dim Créneaux(40) As Variant
lct = comase.L_CT.List(comase.L_CT.ListIndex)
Dim dbComase As dao.Database
Dim tCom As dao.Recordset
Set dbComase = dao.OpenDatabase(Principal.Chemin & "\Réunions.mdb")
Set tCom = dbComase.OpenRecordset("SELECT * FROM Commissions WHERE Inspecteur = " & Chr$(34) & lct & Chr$(34) & " ORDER BY Date, Heure")
v_date = CDate("01/01/2000")
'Suppression des anciens créneaux à l'écran
Commence:
For i = 1 To comase.Controls.Count
If Left(comase.Controls(i - 1).Name, 7) = "Créneau" Then
msg = comase.Controls(i - 1).Name
comase.Controls.Remove msg
GoTo Commence
End If
Next
'Suppression des lignes de code associées
'If Val(Principal.Nb_boutons) > 0 Then
' With ThisWorkbook.VBProject.VBComponents("Comase").CodeModule
' Deb = .ProcStartLine("Private Sub Créneau01_Click", 0)
' NbLi = Val(Principal.Nb_boutons) * 4
' .DeleteLines Deb, NbLi
' End With
'End If
'------------------- Comptage du nombre de créneaux dans le mois -------
a = 0
tCom.MoveFirst
Do While Not tCom.EOF
If Month(tCom("Date")) = Val(comase.Mois) And Year(tCom("Date")) = Val(comase.Année) Then
a = a + 1
End If
tCom.MoveNext
Loop
Principal.Nb_boutons = a
For i = 1 To a
Nombouton = "Créneau" & Format$(i, "00")
Set Créneaux(i) = comase.Controls.Add("Forms.CommandButton.1", Nombouton, True)
Créneaux(i).Height = 42: Créneaux(i).Width = 120
Créneaux(i).BackColor = &HFFFFFF: Créneaux(i).BackStyle = 1
Créneaux(i).ForeColor = &HC00000
Créneaux(i).Font.Name = "Tahoma": Créneaux(i).Font.Size = 9
msg = "Private Sub " & Nombouton & "_Click()" & vbCrLf
msg = msg & "Msgbox " & Nombouton & ".Caption : Stop" & vbCrLf
msg = msg & "Numéro_COM = " & Nombouton & ".TAG : Liste_Invités" & vbCrLf
msg = msg & "End Sub"
With ThisWorkbook.VBProject.VBComponents("Comase").CodeModule
nextline = .CountOfLines + 1
.InsertLines nextline, msg
End With
Next
i = 0: Colonne = 0: Ligne = 0
'---------------- Remplissage et positionnement des créneaux ------------
tCom.MoveFirst
Do While Not tCom.EOF
If Month(tCom("Date")) = Val(comase.Mois) And Year(tCom("Date")) = Val(comase.Année) Then
i = i + 1: Créneaux(i).Visible = True
If tCom("Date") <> v_date Then
v_date = tCom("Date"): Colonne = Colonne + 1: Ligne = 1
Else
Ligne = Ligne + 1
End If
msg = tCom("Heure") & vbCrLf & tCom("Prénom") & " " & tCom("Nom") & vbCrLf & tCom("Référent")
lct = tCom("Numéro")
Créneaux(i).Caption = msg
Créneaux(i).Left = 42 + (Colonne - 1) * 132
Créneaux(i).Top = 110 + (Ligne - 1) * 48
Créneaux(i).tAg = lct
End If
tCom.MoveNext
Loop |
Partager