Discussion :

[morobaboumar]

Bonsoir membres du forum !
La fonction

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Public Function DernierModaliteParent(matrPa As Long, AnneScol As String) As Integer
Dim bd As Database
Dim R As Recordset
Dim SQL As String
 
Set bd = CurrentDb
SQL = "select * from PAYEMENTS  where mlepa = " & matrPa & " and anneescol = '" & AnneScol & " ' order by date desc ;"
Set R = bd.OpenRecordset(SQL)
With R
    If Not .EOF Then
DernierModaliteParent = .Fields("modalité")
    End If
End With
End Function

devrait me ramener à ouverture de la boite de dialogue "PAYEMENTS_SFrmArchive_ParentsBDialogue" la modalité de versement dans la table PAYEMENTS.
cependant la fonction ramène des doublons; c'est à dire entre le 10e versement et 20e versement, les doublons commencent.
Aider moi à y trouver la solution.

Voici le code de contrôle de doublons:

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
'FONCTION POUR CONTROLER LES DOUBLONS DE LA MODALITE DU PAYEMENT DU PARENT
'CHAQUE ANNEE SCOLAIRE
Public Function fDernierModaliteParenPayementParentCetteAnnee1(matrPa As Long, Ane As String) As Long
On Error GoTo DoUKARA
If IsNull(matrPa) Then Exit Function
If IsNull(Ane) Then Exit Function
Dim db As Database
Dim rst As Recordset
Dim SQL As String
    Set db = CurrentDb
    SQL = "select * from PAYEMENTS  where mlepa = " & matrPa & " and anneescol = '" & Ane & "' order by date desc ;"
    Set rst = db.OpenRecordset(SQL)
    If Not rst.EOF Then
        fDernierModaliteParenPayementParentCetteAnnee1 = True
        Else
        fDernierModaliteParenPayementParentCetteAnnee1 = False
    End If
Exit Function
DoUKARA:
    MsgBox "Erreur n° " & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Une erreur est survenue"
End Function

- Pièce jointe

Cordialement.

[morobaboumar]

Salut membres du forum !
Je souhaiterais personnaliser le code suivant que j'ai pu avoir après des recherches:

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
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
 
' ---
' NUMEROTATION AUTOMATIQUE PERSONNALISEE
' ---
' Entrée : strTable  <- Nom de la table.
'          strField  <- Nom du champ contenant le numéro
'          strFormat <- Gabarit décrivant comment formater
'                       le numéro.
'          intDigits <- Nombre de caractères pour le
'                       numéro proprement dit.
'          dtDate    <- Date de référence pour le calcul
'                       de l'année, du mois...
'
Function AutoNumber( _
  ByVal strTable As String, _
  ByVal strField As String, _
  Optional ByVal strFormat As String = "", _
  Optional ByVal intDigits As Integer = 4, _
  Optional ByVal dtDate As Date = #1/1/100#)
 
' Quelques variables...
On Error GoTo AutoNumberErr
Dim varMarkers As Variant, varMark As Variant
Dim strCriteria As String
Dim strNum As String, lngNum As Long, strPart As String
 
' Quelques retraitements...
If dtDate = #1/1/100# Then dtDate = Now()
strField = "[" & strField & "]"
strFormat = Replace(strFormat, "'", "''")
 
' Marqueurs à remplacer
varMarkers = Array("YYYY", "YY", "Q", "MM", "WW", "DD")
For Each varMark In varMarkers
  ' Formater la date et l'injecter dans le template
  strPart = Format(dtDate, varMark, vbMonday, vbFirstFourDays)
  strFormat = Replace(strFormat, "[" & varMark & "]", _
    Format(strPart, String(Len(varMark), "0")))
Next
 
' On cherche la valeur maximale déjà employée dans la table
strCriteria = strField & " LIKE '" & strFormat & "*'"
strNum = Nz(DMax(strField, strTable, strCriteria), "")
 
' On crée le nouveau numéro
lngNum = IIf(strNum = "", 1, Val(Mid(strNum, Len(strFormat) + 1)) + 1)
strFormat = strFormat & Format(lngNum, String(intDigits, "0"))
 
' Valeur finale
AutoNumber = strFormat
Exit Function
 
AutoNumberErr:
  MsgBox "Erreur : " & Err.Description, vbCritical
  AutoNumber = ""
  Exit Function
End Function

voici comment on l'appelle

Code :

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

1
2
3
4
5
6
7
8
9
Private Sub date_BeforeUpdate(Cancel As Integer)
  If IsNull(Me.ModalitePersonnalisse) Then
    Me.ModalitePersonnalisse = AutoNumber("PAYEMENTS", "ModalitePersonnalisse", "Versement:[YYYY].N°", 2)
                    'AutoNumber("PAYEMENTS", "ModalitePersonnalisse", "Versement:[YYYY].", 2)
                    'AutoNumber("PAYEMENTS", "ModalitePersonnalisse", "[YYYY][MM].", 3, #7/31/2018#)
                    'AutoNumber("PAYEMENTS", "ModalitePersonnalisse", "Versement:[YYYY].N°", 2)
  End If
 
End Sub

En y ajoutant des paramètres (mlepa qui est le matricule du parent qui fait le versement;annneescol qui est l'année scolaire en cours) de sorte que le n° .... de versement commence par "Versement:2018-2019.N°01 du MleParent:............" à chaque année scolaire exemple:2018-2019

Voici: le schéma Versement:2018-2019.N°01 du MleParent:.......
Ainsi, à chaque nouvelle année, la modalité de versement de chaque parent commence par Versement N°01 comme indiqué dans mon schéma.

Dans la boite de dialogue"PAYEMENTS_SFrmArchive_ParentsBDialogue".
Clique sur la commande "ANNEE SCOLAIRE SELECTIONNEE:",
ensuite double clique sur le "numpayement" du sous formulaire pour faire apparaître la boite de dialogue.
Je voudrais utiliser ce code en remplacement du premier avec lequel nous débutâmes cette discussion.

Je prie de bien vouloir m'aider trouver la solution aux deux cas.

- Ptèce jointe

Cordialement.

[morobaboumar]

Bonsoir !
J'ai apporté une petite modification à ce code

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
'Fonction ramenant la dernière modalité
Public Function DernierModaliteParent(AnneScol As String, matrPa As Long) As String
On Error GoTo ROUBABOU
If IsNull(AnneScol) Then Exit Function
If IsNull(matrPa) Then Exit Function
Dim db As Database
Dim rst As Recordset
Dim sql As String
Const modalité As Long = 1
 
    Set db = CurrentDb
 sql = "select * from PAYEMENTS where [anneescol]='" & AnneScol & "'and mlepa = " & matrPa & " order by date desc ;"
 
    Set rst = db.OpenRecordset(sql)
    If Not rst.EOF Then
        DernierModaliteParent = Trim(rst.Fields("modalité")) + 1
 
    End If
Exit Function
ROUBABOU:
    MsgBox "Erreur n° " & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Une erreur est survenue"
End Function

Mais toujours le même problème de doublons.
Je vous prie de m'aider.

Cordialement.

[hyperion13]

Salut
La déco, c'est beau, mais ...
Pour info vos form Payements_Modification_Boite_Dialogue et PAYEMENTS_SFrmArchive_Parents et PAYEMENTS_SFrmArchive_ParentsBDialogue ne fonctionnent pas. On ne peut pas ajouter de nouvel enregistrement !!!
Et pour votre numérotation personnalisée, fonction des paiements des parents, cherchez sur DEV un tuto de Christophe Warin qui correspond à votre besoin.

[morobaboumar]

Bonsoir hyperion13 !

Salut
La déco, c'est beau, mais ...
Pour info vos form Payements_Modification_Boite_Dialogue et PAYEMENTS_SFrmArchive_Parents et PAYEMENTS_SFrmArchive_ParentsBDialogue ne fonctionnent pas. On ne peut pas ajouter de nouvel enregistrement

Permettez moi de signaler que j'ai créé des boîtes de dialogues qui me permettent d'insérer les données dans ma BD:
Voici comment on y accède:

- Clique sur la commande "ANNEE SCOLAIRE SELECTIONNEE:",
ensuite double clique sur le "numpayement" du sous formulaire pour faire apparaître la boite de dialogue.

C'est dans cette boîte de dialogue se trouve l'appel du code

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
'Fonction ramenant la dernière modalité
Public Function DernierModaliteParent(AnneScol As String, matrPa As Long) As String
On Error GoTo ROUBABOU
If IsNull(AnneScol) Then Exit Function
If IsNull(matrPa) Then Exit Function
Dim db As Database
Dim rst As Recordset
Dim sql As String
Const modalité As Long = 1
 
    Set db = CurrentDb
 sql = "select * from PAYEMENTS where [anneescol]='" & AnneScol & "'and mlepa = " & matrPa & " order by date desc ;"
 
    Set rst = db.OpenRecordset(sql)
    If Not rst.EOF Then
        DernierModaliteParent = Trim(rst.Fields("modalité")) + 1
 
    End If
Exit Function
ROUBABOU:
    MsgBox "Erreur n° " & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Une erreur est survenue"
End Function

Merci de bien vouloir m'aider.

Cordialement.

[hyperion13]

Comme indiqué dans mon Post précédent le tuto de Christophe Warin correspond à votre besoin.
tbl PAIEMENTS j'ai ajouté les champs chrono et chronoperso
form ARCHIVE PARENTS 2 textbox correspondants aux champs ajoutés dans la tbl PAIEMENTS
form PAYEMENTS_SFrmArchive_ParentsBDialogue j'ai ajouté une Private Sub Form_BeforeUpdate(Cancel As Integer) adaptée selon le tuto de Christophe Warin.
Maintenant vous adaptez selon vos envies.