Discussion :

[morobaboumar]

Salut Membres du forum !
Je souhaite écrire un code qui me permet d'enregistrer automatiquement des nombres entiers successifs de 1;2;3 etc. dans un champ numérique d'une table.
Exemple: ce code doit être paramétré selon un critère (mleparent as long, anneescol as string, idecole as long).
From table where mlepa=" & mleparent....

Voici la capture de la table dans laquelle voudrais je introduire le code en question:


et le champ concerné pour introduire les nombres entiers est "Chrono" ayant pour légende "Indice_Modalité" (voir ligne jaune verticale) ,

le stLinkCriteria selon les champs avec (*)

Le code me permettra de compter le champ "Chrono" de chaque personne de 1 aux nombres entiers successifs jusqu'à la dernière ligne atteinte selon le stLinkCriteria.

je sollicite votre aide.
Cordialement.

[morobaboumar]

Bonjour membres du forum !
Comment adapter le code suivant à ma recherche ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public Function RameneNombreEntier(NumParResp As Long, AnSco As String)
 
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
 
Dim strSelect As String
Dim strSqlWhere As String
Dim strSqlJoin As String
 
If NewRecord Then
 
strSelect = "SELECT Max(chrono) FROM PAYEMENTS_Scolairite"
strSqlWhere = " WHERE "
strSqlJoin = " AND "
strSqlWhere = strSqlWhere & "Format(datescol,""yyyy"") = " & Chr(34) & Format(Me.anneeid, "yyyy") & Chr(34)
strSqlWhere = strSqlWhere & strSqlJoin
strSqlWhere = strSqlWhere & "NumEnregistreParResponsable = " & NumParResp & "and AnneeScolairePay='" & AnSco & "';"
 
strSQL = strSelect & strSqlWhere
'Debug.Print strSql
    Set rst = CurrentDb.OpenRecordset(strSQL)
        With rst
            If Not .EOF Then
            Me![chrono].Value = Nz(.Fields(0).Value, 0) + 1
            Else
            Me![chrono].Value = 1
            End If
            .Close
        End With
End If
    Me.chronoperso.Value = "Versement N° " & Year([datescol]) & "." & Format([chrono], "00")
 
End Function

Message d'erreur:


Cordialement.

[EricDgn]

Bonjour,

Il faut sans doute écrire Me.NewRecord, Me étant le formulaire dans lequel se trouve le code de la fonction (la fonction ne doit pas être placée dans un module externe).

Voir aussi la fonction DMax(), plus simple à employer que le SELECT Max...

Bonne continuation.

[morobaboumar]

Bonsoir membres du forum,
bonsoir EricDgn !
J'ai déplacé le code le module du formulaire, et ajouté le Me. à l'objet "NewRecord"
J'ai introduit la fonction DMax() dans mon code mais à l'appel, ça me ramène des "0".

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Public Function RameneNombreEntier(NumParResp As Long, AnSco As String)
 
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
 
Dim strSelect As String
Dim strSqlWhere As String
Dim strSqlJoin As String
 
If Me.NewRecord Then
 
strSelect = "DMax((chrono) FROM PAYEMENTS_Scolairite)"
strSqlWhere = " WHERE "
strSqlJoin = " AND "
strSqlWhere = strSqlWhere & "Format(datescol,""yyyy"") = " & Chr(34) & Format(Me.anneeid, "yyyy") & Chr(34)
strSqlWhere = strSqlWhere & strSqlJoin
strSqlWhere = strSqlWhere & "NumEnregistreParResponsable = " & NumParResp & "and AnneeScolairePay='" & AnSco & "';"
 
strSQL = strSelect & strSqlWhere
'Debug.Print strSql
    Set rst = CurrentDb.OpenRecordset(strSQL)
        With rst
            If Not .EOF Then
            Me![chrono].Value = Nz(.Fields(0).Value, 0) + 1
            Else
            Me![chrono].Value = 1
            End If
            .Close
        End With
End If
    Me.chronoperso.Value = "Versement N° " & Year([datescol]) & "." & Format([chrono], "00")
 
End Function

Voici comment je le ramène le champ Chrono:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub chrono_GotFocus()
 Me.chrono = RameneNombreEntier(Me.NumEnregistreParResponsable, Me.AnneeScolairePay)
End Sub

Pourriez me donner un exemple de la fonction DMax() par rapport à mon code ?
Je suis stoppé à ce niveau.
Cordialement.

[EricDgn]

Pas vraiment le temps de regarder cela maintenant, mais DMax() s'utilise tout à fait autrement que SELECT ...
Aussi conserver SELECT ...
Cordialement.

[tee_grandbois]

bonsoir morobaboumar,

as-tu vraiment besoin d'une telle fonction pour te ramener la dernière valeur d'un champ ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub chrono_GotFocus()
 
If Me.NewRecord Then
    Me.chrono = RameneProchainChrono(Me.NumEnregistreParResponsable, Me.AnneeScolairePay)
end if 
 
Me.chronoperso = "Versement N° " & Year(Me.[datescol]) & "." & Format(Me.[chrono], "00")
 
End sub

il faut éviter de mettre à jour des champs d'un formulaire directement dans une fonction, sauf si on ne peut pas faire autrement ou si cela évite de la duplication de code, il vaut mieux le faire dans les évènements du formulaire pour plus de lisibilité.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Public Function RameneProchainChrono(NumParResp As Long, AnSco As String) as integer
dim itDernierChrono as long
 
' recherche du dernier chrono
    itDernierChrono = Nz(DMax("chrono","PAYEMENTS_Scolairite","Year(datescol)=" & Me.anneeid & _
    " and NumEnregistreParResponsable = " & NumParResp & " and AnneeScolairePay='" & AnSco & "'"),0)
' renvoie le prochain chrono	
    RameneProchainChrono = itDernierChrono + 1
 
End Function

pour plus d'information sur l'utilisation de Dmax regarde : ici

[morobaboumar]

Bonjour membres du forum,
bonjour tee_grandbois,
J'ai essayé le code que vous m'avez suggéré, voilà la suite:


Piece jointe de la BD.

Cordialement.

[EricDgn]

Bonjour,

Cette routine calcule les indices chronologiques pour les enregistrements existants.
Elle n'est pas à utiliser à l'encodage d'un nouvel enregistrement, là il faudra utiliser un DCount(,,) +1

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub chrono()
   '--- à n'utiliser qu'une seule fois:
   '--- crée les numéros pour les enregistrements déjà encodés
   Dim sSQL As String, rst As Recordset
   Dim mlepa As String, idEts As Long, AnSco As String, Chro As Long
   sSQL = "SELECT mlepa_Enreg_ParResp, ID_EtablissFreq, AnneeScolairePay, dateVersement, chrono" & _
          " FROM PAYEMENTS_Scolairite" & _
          " ORDER BY mlepa_Enreg_ParResp, ID_EtablissFreq, AnneeScolairePay, dateVersement;"
   Set rst = CurrentDb.OpenRecordset(sSQL)
   mlepa = ""
   idEts = 0
   AnSco = ""
   Chro = 0
   With rst
      .MoveLast
      .MoveFirst
      While Not .EOF
         If !mlepa_Enreg_ParResp = mlepa And _
               !ID_EtablissFreq = idEts And _
               !AnneeScolairePay = AnSco Then
            Chro = Chro + 1
         Else
            mlepa = !mlepa_Enreg_ParResp
            idEts = !ID_EtablissFreq
            AnSco = !AnneeScolairePay
            Chro = 1
         End If
         .Edit
         !chrono = Chro
         .Update
         .MoveNext
      Wend
   End With
End Sub

C'est la partie ORDER BY qui décide de l'ordre de comptage.
Le comptage redémarre à 1 à chaque changement d'année (AnneeScolairePay)

A noter que dans la table utilisée il n'y a pas de lien avec l'enfant, uniquement avec le parent. Pas de parent avec plusieurs enfants?

Bonne continuation.

[morobaboumar]

Salut membres du forum,
merci infiniment à vous EricDgn,
merci infiniment à vous tee_grandbois,
merci à toute la famille developpez.net.
Notre discussion est
infiniment.
Cordialement.

[morobaboumar]

Bonjour,
Cette routine calcule les indices chronologiques pour les enregistrements existants.
Elle n'est pas à utiliser à l'encodage d'un nouvel enregistrement, là il faudra utiliser un DCount(,,) +1

S'il vous dans la mesure où l'on souhaiterait employer le code pour l'encodage d'un nouvel enregistrement, qu'est ce qui doit y être
changé.

A+

[EricDgn]

Voilà, après avoir modifié le formulaire Payements_scolarité pour qu'il accepte l'encodage de nouveaux enregistrements, le calcul de 'chrono' se fait ainsi:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub chrono_Enter()
   NumChrono
End Sub
 
Private Sub mlepa_Enreg_ParResp_LostFocus()
   NumChrono
End Sub
 
Private Sub NumEnregistreParResponsable_Change()
   On Error Resume Next '--- parfois erreur quand entrée avec souris
   Me.NumEnregistreParResponsable.Dropdown
End Sub
 
Private Sub NumChrono()
   Dim sWh As String
   If Nz(Me.chrono, 0) = 0 Then
      '--- test données nécessaires exitent
      If Nz(Me.AnneeScolairePay, "") = "" Then
         MsgBox "Il manque AnneeScolairePay"
         Me.AnneeScolairePay.SetFocus
      ElseIf Nz(Me.ID_EtablissFreq, 0) = 0 Then
         MsgBox "Il manque ID_EtablissFreq"
         Me.ID_EtablissFreq.SetFocus
      ElseIf Nz(Me.mlepa_Enreg_ParResp, 0) = 0 Then
         MsgBox "Il manque mlepa_Enreg_ParResp"
         Me.mlepa_Enreg_ParResp.SetFocus
      Else
         '--- détermine n° chrono
         sWh = "mlepa_Enreg_ParResp=" & Me.mlepa_Enreg_ParResp & _
               " AND ID_EtablissFreq=" & Me.ID_EtablissFreq & _
               " AND AnneeScolairePay='" & Me.AnneeScolairePay & "'"
         Me.chrono = DCount("Chrono", "PAYEMENTS_Scolairite", sWh) + 1
      End If
   Else
      '--- ne rien faire: un n° chrono a déjà été donné
   End If
End Sub

Bonne continuation.

[morobaboumar]

Bonsoir membres du forum !
Très heureux.
Les codes fonctionnent parfaitement.
Je ne peux que vous souhaiter beaucoup de bonheurs tout le temps.
Merci infiniment.
A bientôt.