Langage: Visual Basic
Set table = CurrentDb().OpenRecordset(XY, dbOpenDynaset)

Langage: Visual Basic
Function RAZ_TRAITE_HorsCentre()
 
DoCmd.RunSQL "delete * from SD_Traité WHERE (((SD_Traité.Statut)=" & "del" & "));"
'supprime les données de la table traité qui ont été marqué comme a supprimé
 
End Function

Langage: Visual Basic
Function RAZ_TRAITE_HorsCentre()
 
DoCmd.RunSQL "delete * from SD_Traité WHERE Statut=" & "del" & ";"
'supprime les données de la table traité qui ont été marqué comme a supprimé
 
End Function

Langage: Visual Basic
'--- Intérogation de la tbl Adhérents  rs
     rq = "select * from [tbl Adhérents]where " & _
          "[départ]= False"
     Set rs6 = db.OpenRecordset(rq, dbOpenDynaset)
 
'--- Intérogation de la tbl Type de Cours rs4
     rq = "select * from [tbl type de Cours]"
     Set rs4 = db.OpenRecordset(rq, dbOpenSnapshot)
 
'--- Remplissage de la tbl Cours  rs5
     rq = "select * from [tbl Cours]"
     Set rs5 = db.OpenRecordset(rq, dbOpenDynaset)
 
IntEnrg = 1
     rs5.MoveLast
     IntTotalEnrg = rs5.RecordCount
     rs5.MoveFirst
     SysCmd acSysCmdInitMeter, "Mja des catégories et des cours...", IntTotalEnrg
     EtCompteur.Value = IntEnrg                
     EtCompteur1.Value = IntTotalEnrg          
     EtCompteur2.Value = CStr(rs5.RecordCount) 
 
'--- 2 - Boucle sur la table Adhérents rs
     Do Until rs6.EOF
 
'--- Mettre à jour la barre de progression
     SysCmd acSysCmdUpdateMeter, IntEnrg
     Forms![frm Mise à jour nouvelle saison]!Jauge.Object.max = IntTotalEnrg
     Forms![frm Mise à jour nouvelle saison]!Jauge.Object.Value = IntEnrg
 
'--- Détermine la variable age
     Age = Year(DébutSaison) + 1 - Year(Nz(rs6!DateNaissance))
 
     Select Case Age
        Case 0 To 6
             Ecriture_Enregistrement rs4, rs5, rs6, 1
        Case 7 To 11
             Ecriture_Enregistrement rs4, rs5, rs6, 2
        Case 12 To 18
             Ecriture_Enregistrement rs4, rs5, rs6, 3
        Case 19 To 20
             Ecriture_Enregistrement rs4, rs5, rs6, 5
        Case 20 To 99
             Ecriture_Enregistrement rs4, rs5, rs6, 6
 
    End Select
 
    rs6.MoveNext
 
'--- Compter les enregistrements
      EtCompteur.Value = IntEnrg                '
      EtCompteur2.Value = CStr(rs5.RecordCount
      IntEnrg = IntEnrg + 1
Loop

Langage: Visual Basic
Sub Ecriture_Enregistrement(ByRef rs4 As Recordset, ByRef rs5 As Recordset, ByRef rs6 As Recordset, _
                            ByVal Cours As String)
 
Dim DébutSaison As Date
 
DébutSaison = Forms![frm Accueil général]!Modifiable24.Column(2)
 
'--- Recherche du type de cours à appliquer
     rs4.FindFirst "RéfCours = " & Cours
 
'--- Enregistrement des données
      rs5.Edit
        rs5("RéfAdhérent") = rs6!RéfAdhérent
        rs5("CodeCours") = rs4!Code
        rs5("LibelléCours") = rs4!Libellé
        rs5("NomPrénom") = rs6!Nom & " " & rs6!Prénom
        rs5("DateNaissance") = rs6!DateNaissance
        rs5("Age") = Year(DébutSaison) - Year(rs6!DateNaissance)
      rs5.Update
End Sub

Langage: SQL
Private Sub MjaDépartTblAdhérents()
 
ON Error GoTo GestionErreur
 
     DoCmd.OpenForm "frm message"
 
'--- Intérogation de la tbl adhérents rs
      rq = "select * From [tbl Adhérents]"
      Set rs = db.OpenRecordset(rq, dbOpenDynaset)
 
'--- Boucle sur la table Adhérents
      Do Until rs.EOF
 
'--- Recherche du millesime licence et mja du champ DateDépart, et case à cocher Départ
      If Not rs("MillLicence") <> MillLicence Then
          rq = "update [tbl Adhérents] set [DateFinAdhésion]=Null, Départ=False" & _
               " Where NuméroLicence=" & CStr(Nz(rs("numéroLicence").Value)) & " and Lettre=" & Chr(34) & _
                 Nz(rs("Lettre").Value) & Chr(34) & " ;"
     db.Execute rq
Else
     If rs("MillLicence") <> MillLicence And IsNull(rs("DateFinAdhésion")) Then
          rq = "update [tbl Adhérents] set DateFinAdhésion=" & DateUS(DébutSaison) & ", Départ=True" & _
               " Where NuméroLicence=" & CStr(Nz(rs("numéroLicence").Value)) & " and Lettre=" & Chr(34) & _
                 Nz(rs("Lettre").Value) & Chr(34) & " ;"
     db.Execute rq
     End If
     End If
     rs.MoveNext
     Loop
 
GestionErreur:
 
'--- Liberer les objets
     SET rs = Nothing
   End Sub

Langage: SQL
Private Sub Form_Open(Cancel AS Integer)
Dim prt AS Printer
Dim db AS DAO.DATABASE
Dim doc AS DAO.Document
Dim strNom AS String
Dim strDescription AS String
 
ON Error Resume Next
 
SET db = CurrentDb
 
'--- Lister les imprimantes disponibles
     Me.lstImprimantes.RowSource = ""
 
     For Each prt In Application.Printers
         Me.lstImprimantes.AddItem prt.DeviceName
        'Debug.Print prt.DeviceName
     Next
'--- Lister les états disponibles
     For Each doc In db.Containers("Reports").Documents
         strDescription = doc.Name
         strDescription = doc.Properties("Description")
         strNom = doc.Properties("Name")
 
     'Affichage  'état ou des états à imprimer
     Select Case Forms![frm Publipostage]!Cadre48
       Case 1
          'Adhérents
          IF Trim(strDescription) = "A030" OR Trim(strDescription) = "A031" OR Trim(strDescription) = "A032" Then
             Me.cmbEtatsListing.AddItem doc.Name & ";" & Mid(strNom, 4)
          ElseIf Trim(strDescription) = "E040" OR Trim(strDescription) = "E041" Then
             Me.cmbEtatsEtiquettes.AddItem doc.Name & ";" & Mid(strNom, 4)
          End IF
 
       Case 2
          'Familles
          If Trim(strDescription) = "A030" Or Trim(strDescription) = "A031" Or Trim(strDescription) = "A032" Then
             Me.cmbEtatsListing.AddItem doc.Name & ";" & Mid(strNom, 4)
          ElseIf Trim(strDescription) = "E040" Or Trim(strDescription) = "E041" Then
             Me.cmbEtatsEtiquettes.AddItem doc.Name & ";" & Mid(strNom, 4)
          End If
End Select
     Next