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
| Option Compare Database
Private Sub chktireur_Click()
If Me.chktireur Then
Me.cmbRechtireur.Visible = False
Else
Me.cmbRechtireur.Visible = True
End If
RefreshQuery
End Sub
Private Sub chkdiscipline_Click()
If Me.chkdiscipline Then
Me.cmbRechdiscipline.Visible = False
Else
Me.cmbRechdiscipline.Visible = True
End If
RefreshQuery
End Sub
Private Sub chkstand_Click()
If Me.chkstand Then
Me.txtRechstand.Visible = False
Else
Me.txtRechstand.Visible = True
End If
RefreshQuery
End Sub
Private Sub chkdate_Click()
If Me.chkdate Then
Me.txtRechdate.Visible = False
Else
Me.txtRechdate.Visible = True
End If
RefreshQuery
End Sub
Private Sub cmbRechtireur_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
Private Sub cmbRechdiscipline_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
Private Sub Form_Activate()
Me.Recalc
End Sub
Private Sub Form_Current()
Me.Caption = "RCHERCHE D'UN MATCH"
End Sub
Private Sub Form_Load()
Dim ctl As Control
For Each ctl In Me.Controls
Select Case Left(ctl.Name, 3)
Case "chk"
ctl.Value = -1
Case "lbl"
ctl.Caption = "*/*"
Case "txt"
ctl.Visible = False
ctl.Value = ""
Case "cmb"
ctl.Visible = False
End Select
Next ctl
Me.Liste33.RowSource = "SELECT id_match,id_tireur,nom_tireur,prenom_tireur,nom_discipline,nom_stand,date_match, classement,score_match FROM rmatch;"
Me.Liste33.Requery
End Sub
Private Sub RefreshQuery()
Dim SQL As String
Dim SQLWhere As String
SQL = "SELECT id_match,id_tireur,nom_tireur,prenom_tireur,nom_discipline,nom_stand,date_match, classement,score_match FROM rmatch Where rmatch!id_match <> 0 "
If Not Me.chktireur Then
SQL = SQL & "And rmatch!id_tireur like '*" & Me.cmbRechtireur & "*' "
Me.Liste33.RowSource = SQL
Me.Liste33.Requery
End If
If Not Me.chkdiscipline Then
SQL = SQL & "And rmatch!nom_discipline = '" & Me.cmbRechdiscipline & "' "
Me.Liste33.RowSource = SQL
Me.Liste33.Requery
End If
If Not Me.chkstand Then
SQL = SQL & "And rmatch!nom_stand like '*" & Me.txtRechstand & "*' "
Me.Liste33.RowSource = SQL
Me.Liste33.Requery
End If
If Not Me.chkdate Then
SQL = SQL & "And rmatch!date_match like '*" & Me.txtRechdate & "*' "
Me.Liste33.RowSource = SQL
Me.Liste33.Requery
End If
SQLWhere = Trim(Right(SQL, Len(SQL) - InStr(SQL, "Where ") - Len("Where ") + 1))
SQL = SQL & ";"
Me.lblStats.Caption = DCount("*", "rmatch", SQLWhere) & " / " & DCount("*", "rmatch")
End Sub
Private Sub Form_Open(Cancel As Integer)
Dim a
' Met à jour la légende et remplit la liste d'options.
[ChoixOption].Value = 2
FillOptions
'Mise à jour de l'étiquette comportant le nom de la saison en cours
If Me.TexteSaison.ListCount = 0 Then
Me.TexteSaison.Value = "Aucune saison définie : créez-là dans le menu Setup"
Else
Me.TexteSaison = Nz(DLookup("Parameter", "TblValeursParDéfaut", "object='SaisonEnCours'"), "*")
'Met à jour les champs cachés TexteDateDebutSaison et TexteDateFinSaison servant
'à filtrer les enregistrements
Me.TexteDateDebutSaison = Nz(Me.TexteSaison.Column(2))
Me.TexteDateFinSaison = Nz(Me.TexteSaison.Column(3))
End If
End Sub
Private Sub liste33_DblClick(Cancel As Integer)
DoCmd.OpenForm "resultat_recherche", acNormal, , "[id_match] = " & Me.Liste33
End Sub
Private Sub TexteSaison_Click()
Dim rst As DAO.Recordset
Dim chSQL As String
chSQL = " SELECT ID, FieldName,Parameter FROM TblValeursParDéfaut "
chSQL = chSQL & "WHERE Object = 'SaisonEnCOurs' AND ID=1;"
Set rst = CurrentDb.OpenRecordset(chSQL)
rst.Edit
rst!FieldName = Me.TexteSaison.Column(1)
rst!Parameter = Me.TexteSaison.Column(0)
rst.Update
rst.Close
Me.ListeOption.SetFocus
Me.TexteDateDebutSaison = Nz(Me.TexteSaison.Column(2))
Me.TexteDateFinSaison = Nz(Me.TexteSaison.Column(3))
End Sub
Private Sub txtRechstand_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
Private Sub txtRechdate_BeforeUpdate(Cancel As Integer)
RefreshQuery
End Sub
Private Sub Fermer_Click()
On Error GoTo Err_Fermer_Click
DoCmd.Close
Exit_Fermer_Click:
Exit Sub
Err_Fermer_Click:
MsgBox Err.Description
Resume Exit_Fermer_Click
End Sub |
Partager