Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Membre du Club Avatar de morobaboumar
    Inscrit en
    septembre 2009
    Messages
    203
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 203
    Points : 66
    Points
    66

    Par défaut Comment insérer la modalité de versement grâce à la numérotation automatique personnalisée

    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.
    Fichiers attachés Fichiers attachés
    Le savoir est la lumière de l'esprit
    Le chemin de la réussite

    Les savants sont les héritiers de la science
    Qui cherche positivement trouve
    Tout ce qui brille n'est pas l'or ou diamant
    Mais l'or et le diamant se trouvent avec sagesse, intelligence et effort

  2. #2
    Membre du Club Avatar de morobaboumar
    Inscrit en
    septembre 2009
    Messages
    203
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 203
    Points : 66
    Points
    66

    Par défaut

    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.
    Fichiers attachés Fichiers attachés
    Le savoir est la lumière de l'esprit
    Le chemin de la réussite

    Les savants sont les héritiers de la science
    Qui cherche positivement trouve
    Tout ce qui brille n'est pas l'or ou diamant
    Mais l'or et le diamant se trouvent avec sagesse, intelligence et effort

  3. #3
    Membre du Club Avatar de morobaboumar
    Inscrit en
    septembre 2009
    Messages
    203
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 203
    Points : 66
    Points
    66

    Par défaut

    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.
    Le savoir est la lumière de l'esprit
    Le chemin de la réussite

    Les savants sont les héritiers de la science
    Qui cherche positivement trouve
    Tout ce qui brille n'est pas l'or ou diamant
    Mais l'or et le diamant se trouvent avec sagesse, intelligence et effort

  4. #4
    Membre expérimenté Avatar de hyperion13
    Homme Profil pro
    Calot120 - Enseignant Post Bac
    Inscrit en
    octobre 2007
    Messages
    1 114
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France

    Informations professionnelles :
    Activité : Calot120 - Enseignant Post Bac
    Secteur : Enseignement

    Informations forums :
    Inscription : octobre 2007
    Messages : 1 114
    Points : 1 716
    Points
    1 716

    Par défaut

    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.
    "Le savoir est la seule matière qui s'accroit quand on la partage" (Socrate)
    GMT+4 - 21°19'18" S - 055°25'32" E
    Inutile de me contacter par MP
    Merci de cliquer sur si la réponse est pertinente. N'oubliez pas svp de clôturer le sujet en cliquant sur

  5. #5
    Membre du Club Avatar de morobaboumar
    Inscrit en
    septembre 2009
    Messages
    203
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 203
    Points : 66
    Points
    66

    Par défaut

    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.
    Le savoir est la lumière de l'esprit
    Le chemin de la réussite

    Les savants sont les héritiers de la science
    Qui cherche positivement trouve
    Tout ce qui brille n'est pas l'or ou diamant
    Mais l'or et le diamant se trouvent avec sagesse, intelligence et effort

  6. #6
    Membre expérimenté Avatar de hyperion13
    Homme Profil pro
    Calot120 - Enseignant Post Bac
    Inscrit en
    octobre 2007
    Messages
    1 114
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 54
    Localisation : France

    Informations professionnelles :
    Activité : Calot120 - Enseignant Post Bac
    Secteur : Enseignement

    Informations forums :
    Inscription : octobre 2007
    Messages : 1 114
    Points : 1 716
    Points
    1 716

    Par défaut

    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.
    Fichiers attachés Fichiers attachés
    "Le savoir est la seule matière qui s'accroit quand on la partage" (Socrate)
    GMT+4 - 21°19'18" S - 055°25'32" E
    Inutile de me contacter par MP
    Merci de cliquer sur si la réponse est pertinente. N'oubliez pas svp de clôturer le sujet en cliquant sur

  7. #7
    Membre du Club Avatar de morobaboumar
    Inscrit en
    septembre 2009
    Messages
    203
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 203
    Points : 66
    Points
    66

    Par défaut

    Bonsoir hyperion13 !
    Je vous remercie infiniment ainsi que toute la famille developpez.net.
    Vous avez résolu la partie A de notre discussion (voir le résultat:- pièce jointe):ECOLE_OUMAR_Plus.

    Cependant, je sollicite encore votre aide pour la partie B qui concerne le code suivant:
    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
    combien important. Son problème ce sont les doublons.
    Cordialement.
    Fichiers attachés Fichiers attachés
    Le savoir est la lumière de l'esprit
    Le chemin de la réussite

    Les savants sont les héritiers de la science
    Qui cherche positivement trouve
    Tout ce qui brille n'est pas l'or ou diamant
    Mais l'or et le diamant se trouvent avec sagesse, intelligence et effort

  8. #8
    Membre du Club Avatar de morobaboumar
    Inscrit en
    septembre 2009
    Messages
    203
    Détails du profil
    Informations forums :
    Inscription : septembre 2009
    Messages : 203
    Points : 66
    Points
    66

    Par défaut

    Bonsoir membres du forum !

    Après plusieurs testes, je constate que le Versement N° .... ne reprendre pas à partir du Versement N° 1 chaque nouvelle année scolaire selon chaque parent d'élèves.
    Je vous envoie la pièce jointe d'essais.
    Nom : CaptureESSAI 2013-2014.PNG
Affichages : 2
Taille : 31,7 Ko
    Nom : CaptureESSAI 2018-2019.PNG
Affichages : 2
Taille : 35,0 Ko
    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
    Private Sub date_BeforeUpdate(Cancel As Integer)
     
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim strSQL As String
     
    Set dbs = CurrentDb
     
    strSQL = "PAYEMENTS.mlepa, Count(PAYEMENTS.anneescol) AS CountOfRec " & vbCrLf & _
        "FROM PAYEMENTS " & vbCrLf & _
        "GROUP BY PAYEMENTS.mlepa " & vbCrLf & _
        "HAVING (((PAYEMENTS.mlepa)=" & mlepa & "));"
     
    If Me.NewRecord Then
    Set rst = CurrentDb.OpenRecordset("SELECT Max(chrono) FROM PAYEMENTS WHERE mlepa =" & Me.mlepa)
    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
     
    If IsNull(Me.chrono.Value) Then
        Me.chrono.Value = Format(Nz(DMax("[chrono]", "[PAYEMENTS]", "[mlepa]=" & Me.mlepa), 0) + 1)
    End If
        Me.chronoperso.Value = "Versement N° " & Me.chrono
    End Sub
    Cordialement.
    Fichiers attachés Fichiers attachés
    Le savoir est la lumière de l'esprit
    Le chemin de la réussite

    Les savants sont les héritiers de la science
    Qui cherche positivement trouve
    Tout ce qui brille n'est pas l'or ou diamant
    Mais l'or et le diamant se trouvent avec sagesse, intelligence et effort

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo