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

Access Discussion :

Gestion d' Héritage Succession d'un défunt


Sujet :

Access

  1. #1
    Membre averti
    Gestion d' Héritage Succession d'un défunt
    Bonjour membres du forum,
    Je viens de créer une base de données sur la Gestion d' Héritage Succession d'un défunt.
    Espérant trouver une suite favorable auprès de vous, je sais, en abordant ce sujet très très très
    sensible vous me poserez de nombreuses questions.

    Mais en attendant, Question:

    1°) a) Comment écrire 1/8 (un huitième) des biens (argent liquide) qui est la part des épouses dans un champ "TAUX_Part" de la table "Tbl_Part_Perçue_Montant"?
    b) Comment écrire 1/2 (un demi) des biens (argent liquide) qui est la part de chaque fille dans un champ "TAUX_Part" de la table "Tbl_Part_Perçue_Montant" ?
    c) Comment écrire 1 (une part) des biens (argent liquide) qui est la part de chaque fils dans un champ "TAUX_Part" de la table "Tbl_Part_Perçue_Montant"?




    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

  2. #2
    Modérateur

    Bonjour.

    Tu veux voir afficher 1/8, 1/2 ou tu peux travailler avec 0.125 et 0.5 qui sont les valeurs correspondantes ?

    Si c'est la 1ère option j'irai avec 2 champs : Numérateur et Dénominateur (ex : pour 1/2, Numérateur = 1, Dénominateur = 2) en plus cette solution te permet de stocker 1/3 ou 1/7 qui ne sont pas valeurs finies.

    Sinon un simple champ réel double fera l'affaire, non ?

    A+
    Vous voulez une réponse rapide et efficace à vos questions téchniques ?
    Ne les posez pas en message privé mais dans le forum, vous bénéficiez ainsi de la compétence et de la disponibilité de tous les contributeurs.
    Et aussi regardez dans la FAQ Access et les Tutoriaux Access. C'est plein de bonnes choses.

  3. #3
    Membre averti
    Citation Envoyé par marot_r Voir le message
    Bonjour.
    Tu veux voir afficher 1/8, 1/2 ou tu peux travailler avec 0.125 et 0.5 qui sont les valeurs correspondantes ?
    Si c'est la 1ère option j'irai avec 2 champs : Numérateur et Dénominateur (ex : pour 1/2, Numérateur = 1, Dénominateur = 2) en plus cette solution te permet de stocker 1/3 ou 1/7 qui ne sont pas valeurs finies.
    Sinon un simple champ réel double fera l'affaire, non ?
    A+
    Bonjour marot_r,
    Merci pour votre réponse.
    Je vous rappelle que la discussion continue. Le temps pour moi de mettre en vigueur votre suggestion.
    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 averti
    Bonsoir membres du forum,
    Mon code suivant devrait me ramener le taux de la part chaque membres de famille.
    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 le tauxElhadji Mahmoud Sano de la part de chaque membre de la
    'famille.
    Public Function F_RamenantTauxMembreFamilleEMS(IDPartx As Long) As Long
    On Error GoTo MOROBABOUMAR
    Dim bd As Database
    Dim rs As Recordset
    Dim sql As String
    Set bd = CurrentDb
    sql = "select ([Taux_PartNumerateur]:[Taux_PartNumerateur]) as TauxPercuMEMS from Tbl_Part_Perçue_Montant where ID_Part = " & IDPartx & ""
     
    Set rs = bd.OpenRecordset(sql)
    If rs.EOF Or IsNull(rs.Fields("TauxPercuMEMS")) Then
       F_RamenantTauxMembreFamilleEMS = 0
    Else
        F_RamenantTauxMembreFamilleEMS = rs.Fields("TauxPercuMEMS")
    End If
    Exit Function
     
    MOROBABOUMAR:
        MsgBox "Erreur n° " & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Une erreur est survenue"
    End Function


    Mais voici la capture du message d"erreur.



    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

  5. #5
    Membre averti
    Bonsoir membres du forum,
    J'ai corrigé l'erreur de syntaxe de mon 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 le tauxElhadji Mahmoud Sano de la part de chaque membre de la
    'famille.
    Public Function F_RamenantTauxMembreFamilleEMS(IDPartx As Long) As Long
    On Error GoTo MOROBABOUMAR
    Dim bd As Database
    Dim rs As Recordset
    Dim sql As String
    Set bd = CurrentDb
    sql = "select ([Taux_PartNumerateur]/[Taux_PartDenominateur]) as TauxPercuMEMS from Tbl_Part_Perçue_Montant where ID_Part = " & IDPartx & ""
     
    Set rs = bd.OpenRecordset(sql)
    If rs.EOF Or IsNull(rs.Fields("TauxPercuMEMS")) Then
       F_RamenantTauxMembreFamilleEMS = 0
    Else
        F_RamenantTauxMembreFamilleEMS = rs.Fields("TauxPercuMEMS")
    End If
    Exit Function
     
    MOROBABOUMAR:
        MsgBox "Erreur n° " & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Une erreur est survenue"
    End Function


    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 averti
    Bonsoir membres du forum,
    La procédure suivante devrait me permettre d'insérer dans la table "Tbl_MontantLiquidePartgeHEMS" toutes les
    données sélectionnées à partir de la table "Tbl_PartageBiensArgentEMS" au clique de la commande "BtnEnregistrerLesHeritiersEMS".
    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
     
    Sub AjouterHeritiersEMS(IdMontDecl As Long, IdFond As Long)
    On Error GoTo OUMAR
    Dim BD As Database
    Dim rs As Recordset
    Dim SQL As String
    Set BD = CurrentDb
    DoCmd.SetWarnings False
     
    SQL = "select * from [Tbl_PartageBiensArgentEMS] where NumEnregPartage =" & IdMontDecl & " and NoFondateur = " & IdFond & " and ChoisirLesHEMS order  by RowNum desc;"
     
    Set rs = BD.OpenRecordset(SQL)
     
    Set rs = BD.OpenRecordset(SQL)
    With rs
        If .EOF Then
        Else
            .MoveFirst
            Do While Not .EOF
       SQL = "INSERT INTO Tbl_MontantLiquidePartgeHEMS" _
        & "(NumEnregistreHEMS,NoFondatHEMS,MembresFamilleConcernesHEMS,PartPerçueHEMS,NumBienArgentHEMS) VALUES(" _
        & fNumEnregistreHEMS() & "," _
        & Me.NoFondateur & "," _
        & Me.MembresFamilleConcernes & "," _
        & Me.StatutMembreFamille & "," _
        & Me.PartPerçue & ")"                              'F_RamenantTauxMembreFamilleEMS(Me.PartPerçue)
            DoCmd.RunSQL SQL
            .MoveNext
            Loop
        End If
    End With
     
    DoCmd.SetWarnings True
     
        Forms("Frm_Fondateur").Controls("Tbl_MontantLiquidePartgeHEMS_SFrm").Requery
        btAucun_Click
    Exit Sub
    OUMAR:
    MsgBox Err.Description, vbExclamation, Err.Number
    End Sub


    Malheureusement, elle n'insère qu'un seul enregistrement dans la table "Tbl_MontantLiquidePartgeHEMS"

    Code de la commande de sélection des données à insérer de la table "Tbl_MontantLiquidePartgeHEMS"

    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
    Private Sub btAucun_Click()
    On Error Resume Next
    DoCmd.SetWarnings False
    DoCmd.RunSQL "UPDATE Tbl_PartageBiensArgentEMS SET ChoisirLesHEMS=0;"
    Me.Requery
    End Sub
     
    Private Sub btTous_Click()
    On Error Resume Next
    DoCmd.SetWarnings False
    DoCmd.RunSQL "UPDATE Tbl_PartageBiensArgentEMS SET ChoisirLesHEMS=-1;"
    Me.Requery
    End Sub
     
    Private Sub Form_Load()
    btAucun_Click
    End Sub







    Question: comment faire en sorte que les données sélectionnées grâce aux boutons "btTous_Click()" et "btAucun_Click" puissent tous ensembles
    être insérées dans la table de destination "Tbl_MontantLiquidePartgeHEMS" ?

    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

  7. #7
    Expert éminent
    bonjour,

    Malheureusement, elle n'insère qu'un seul enregistrement dans la table "Tbl_MontantLiquidePartgeHEMS"
    combien d'enregistrements renvoie le recordset ? pour le savoir, faire un debug.? rs.recordcount après avoir fait un rs.Movelast
    Quand on est derrière l'écran on n'a aucun clavier sous les mains ...

  8. #8
    Membre averti
    Citation Envoyé par tee_grandbois Voir le message
    bonjour,
    combien d'enregistrements renvoie le recordset ? pour le savoir, faire un debug.? rs.recordcount après avoir fait un rs.Movelast
    Bonsoir membres du forum,
    bonsoir tee_grandbois,

    voici comment j'ai placé les éléments de code que vous m'avez suggérés:
    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
    Sub AjouterHeritiersEMS(IdMontDecl As Long, IdFond As Long)
    On Error GoTo OUMAR
    Dim BD As Database
    Dim rs As Recordset
    Dim SQL As String
    Set BD = CurrentDb
    DoCmd.SetWarnings False
    
    SQL = "select * from [Tbl_PartageBiensArgentEMS] where NumEnregPartage =" & IdMontDecl & " and NoFondateur = " & IdFond & " and ChoisirLesHEMS order  by RowNum desc;"
    
    Set rs = BD.OpenRecordset(SQL)
    
    Set rs = BD.OpenRecordset(SQL)
    With rs
        If .EOF Then
        Else
            .MoveFirst
    
            Do While Not .EOF
       SQL = "INSERT INTO Tbl_MontantLiquidePartgeHEMS" _
        & "(NumEnregistreHEMS,NoFondatHEMS,MembresFamilleConcernesHEMS,PartPerçueHEMS,NumBienArgentHEMS) VALUES(" _
        & fNumEnregistreHEMS() & "," _
        & Me.NoFondateur & "," _
        & Me.MembresFamilleConcernes & "," _
        & Me.StatutMembreFamille & "," _
        & Me.PartPerçue & ")"                              'F_RamenantTauxMembreFamilleEMS(Me.PartPerçue)
            DoCmd.RunSQL SQL
            .MoveNext
         '________________________
            rs.MoveLast
        Debug.Print rs.RecordCount
        '_________________________
    
            Loop
        End If
    End With
    
    DoCmd.SetWarnings True
        
        Forms("Frm_Fondateur").Controls("Tbl_MontantLiquidePartgeHEMS_SFrm").Requery
        btAucun_Click
    Exit Sub
    OUMAR:
    MsgBox Err.Description, vbExclamation, Err.Number
    End Sub


    Mais helas, la table s'est remplie d'enregistrement a ne pas en finir que doit on faire ?
    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

  9. #9
    Membre averti
    SVP à quelle ligne du code doit on placer
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
     
            rs.MoveLast
        Debug.Print rs.RecordCount
        '_________________________

    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

  10. #10
    Expert éminent
    surtout pas dans la boucle mais juste avant ! c'est quand même le minimum à savoir quand on code en VBA
    Quand on est derrière l'écran on n'a aucun clavier sous les mains ...

  11. #11
    Membre averti
    Citation Envoyé par tee_grandbois Voir le message
    surtout pas dans la boucle mais juste avant ! c'est quand même le minimum à savoir quand on code en VBA

    Bonjour tee_grandbois,

    Il y a seulement 1 un seul enregistrement qui est inséré dans la table "Tbl_MontantLiquidePartgeHEMS".
    Et à chaque clique sur le bouton de commande, c'est toujours la même ligne qui est répétée.
    Comment résoudre ce problème sachant que mon objectif est de retrouver dans la table de destination toutes les données
    transférées.

    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
    Sub AjouterHeritiersEMS(IdMontDecl As Long, IdFond As Long)
    On Error GoTo OUMAR
    Dim BD As Database
    Dim rs As Recordset
    Dim SQL As String
    Set BD = CurrentDb
    DoCmd.SetWarnings False
    
    SQL = "select * from [Tbl_PartageBiensArgentEMS] where NumEnregPartage =" & IdMontDecl & " and NoFondateur = " & IdFond & " and ChoisirLesHEMS " & ";"
    
    Set rs = BD.OpenRecordset(SQL)
    
    Set rs = BD.OpenRecordset(SQL)
    
    '__________________________
        rs.MoveLast
        Debug.Print rs.RecordCount
    '__________________________
    
    
    With rs
    
        If .EOF Then
      
        Else
       .MoveFirst
    
        
            Do While Not .EOF
       SQL = "INSERT INTO Tbl_MontantLiquidePartgeHEMS" _
        & "(NumEnregistreHEMS,NoFondatHEMS,MembresFamilleConcernesHEMS,PartPerçueHEMS,NumBienArgentHEMS) VALUES(" _
        & fNumEnregistreHEMS() & "," _
        & Me.NoFondateur & "," _
        & Me.MembresFamilleConcernes & "," _
        & Me.StatutMembreFamille & "," _
        & Me.PartPerçue & ")"                              'F_RamenantTauxMembreFamilleEMS(Me.PartPerçue)
            DoCmd.RunSQL SQL
            rs.MoveNext
       
        
       Loop
       
         End If
    End With
     
        
    DoCmd.SetWarnings True
        
        Forms("Frm_Fondateur").Controls("Tbl_MontantLiquidePartgeHEMS_SFrm").Requery
        btAucun_Click
    Exit Sub
    OUMAR:
    MsgBox Err.Description, vbExclamation, Err.Number
    End Sub


    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

  12. #12
    Expert éminent
    bonjour,
    tu n'a pas répondu à la question: combien d'enregistrements renvoie le recordset avec Debug.Print rs.RecordCount ?
    Question: comment faire en sorte que les données sélectionnées grâce aux boutons "btTous_Click()" et "btAucun_Click" puissent tous ensembles
    être insérées dans la table de destination "Tbl_MontantLiquidePartgeHEMS" ?
    si ce sont les données du formulaire qu'il faut parcourir, c'est sur le RecordSet de celui-ci qu'il faut boucler, en utilisant le RecordSetClone:
    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
    Sub AjouterHeritiersEMS(IdMontDecl As Long, IdFond As Long)
    On Error GoTo OUMAR
    Dim BD As Database
    Dim rs As Recordset
    Dim SQL As String
    Set BD = CurrentDb
     
    Set rs = me.recordsetclone
    With rs
        .MoveFirst
     
        Do Until .EOF
    	if .ChoisirLesHEMS Then
                SQL = "INSERT INTO Tbl_MontantLiquidePartgeHEMS" _
                & "(NumEnregistreHEMS,NoFondatHEMS,MembresFamilleConcernesHEMS,PartPerçueHEMS,NumBienArgentHEMS) VALUES(" _
                & fNumEnregistreHEMS() & ",'" _
                & .NoFondateur & "','" _
                & .MembresFamilleConcernes & "','" _
                & .StatutMembreFamille & "','" _
                & .PartPerçue & "')"                              'F_RamenantTauxMembreFamilleEMS(Me.PartPerçue)
                ' insertion de l'enregistrement
    	    BD.Execute SQL, dbfailonerror
    	end if 
            .MoveNext
         '________________________
        Loop
     
    End With
        BD.close: set BD = nothing
        Forms("Frm_Fondateur").Controls("Tbl_MontantLiquidePartgeHEMS_SFrm").Requery
        btAucun_Click
    Exit Sub
    OUMAR:
    MsgBox Err.Description, vbExclamation, Err.Number
    End Sub

    sans garantie que cela fonctionne, ne sachant pas où est situé le code (formulaire, sous-formulaire ....) ce sera donc à adapter selon le contexte, également, le code doit être inséré dans le la partie code VBA du formulaire, pas dans un module standard.
    Du coup, les paramètres de la procédure (IdMontDecl, IdFond) ne devraient plus servir
    Quand on est derrière l'écran on n'a aucun clavier sous les mains ...

  13. #13
    Membre averti
    Bonjour membres du forum,
    bonjour tee_grandbois,
    Après plusieurs essais le code insère les mêmes informations 18 fois à chaque clique.




    Permettez moi de vous envoyer la copie de ma BD pour faire le constat.
    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

  14. #14
    Expert éminent
    bonsoir,
    ce n'est pas le code que j'ai donné :
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
                & Me.NoFondateur & "','" _
                & Me.MembresFamilleConcernes & "','" _
                & Me.StatutMembreFamille & "','" _
                & Me.PartPerçue & "')"                              'F_RamenantTauxMembreFamilleEMS(Me.PartPerçue)

    j'ai donné celui-ci;
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
                & .NoFondateur & "','" _
                & .MembresFamilleConcernes & "','" _
                & .StatutMembreFamille & "','" _
                & .PartPerçue & "')"                              'F_RamenantTauxMembreFamilleEMS(Me.PartPerçue)

    en mettant Me, tu reste sur l'enregistrement en cours (le premier)
    Quand on est derrière l'écran on n'a aucun clavier sous les mains ...

  15. #15
    Expert éminent
    bonsoir morobaboumar,
    mon code méritait quelques corrections mais c'est vrai que je ne l'avais pas testé, c'est chose faite.
    merci de le copier tel quel, si message d'erreur, me le dire par message sur le forum plutôt que de tenter le corriger:
    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
    Sub AjouterHeritiersEMS(IdMontDecl As Long, IdFond As Long)
    On Error GoTo OUMAR
    Dim BD As Database
    Dim rs As Recordset
    Dim SQL As String
    Set BD = CurrentDb
     
    Set rs = Me.RecordsetClone
     
    With rs
        .MoveFirst
     
        Do Until .EOF
        If rs("ChoisirLesHEMS") Then
                SQL = "INSERT INTO Tbl_MontantLiquidePartgeHEMS" _
                & "(NumEnregistreHEMS,NoFondatHEMS,MembresFamilleConcernesHEMS,PartPerçueHEMS,NumBienArgentHEMS) VALUES(" _
                & fNumEnregistreHEMS() & ",'" _
                & rs("NoFondateur") & "','" _
                & rs("MembresFamilleConcernes") & "','" _
                & rs("StatutMembreFamille") & "','" _
                & rs("PartPerçue") & "')"                              'F_RamenantTauxMembreFamilleEMS(Me.PartPerçue)
                ' insertion de l'enregistrement
            BD.Execute SQL, dbFailOnError
        End If
            .MoveNext
         '________________________
        Loop
     
    End With
        BD.Close: Set BD = Nothing
        Forms("Frm_Fondateur").Controls("Tbl_MontantLiquidePartgeHEMS_SFrm").Requery
        btAucun_Click
    Exit Sub
    OUMAR:
    MsgBox Err.Description, vbExclamation, Err.Number
    End Sub
    Quand on est derrière l'écran on n'a aucun clavier sous les mains ...

  16. #16
    Membre averti
    Bonjour membres du forum,
    bonjour tee_grandbois,

    Merci infiniment. Vous m'avez offert la solution recherchée.
    J'en ai profité pour ajouter de 2 nouveaux champs aux 2 tables concernées par le
    code que vous m'avez donné.
    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
     
    Sub AjouterHeritiersEMS(IdMontDecl As Long, IdFond As Long)
    On Error GoTo OUMAR
    Dim bd As Database
    Dim rs As Recordset
    Dim sql As String
    Set bd = CurrentDb
     
    Set rs = Me.RecordsetClone
     
    With rs
        .MoveFirst
     
        Do Until .EOF
        If rs("ChoisirLesHEMS") Then
                sql = "INSERT INTO Tbl_MontantLiquidePartgeHEMS" _
                & "(NumEnregistreHEMS,NoFondatHEMS,MembresFamilleConcernesHEMS,StatutMembreFamil,PartPerçueHEMS,NumBienArgentHEMS) VALUES(" _
                & fNumEnregistreHEMS() & ",'" _
                & rs("NoFondateur") & "','" _
                & rs("MembresFamilleConcernes") & "','" _
                & rs("StatutMembreFamille") & "','" _
                & rs("PartPerçue") & "','" _
                & rs("NumBienArgentHEMS") & "')"                              'F_RamenantTauxMembreFamilleEMS(Me.PartPerçue)
                ' insertion de l'enregistrement
            bd.Execute sql, dbFailOnError
        End If
            .MoveNext
         '________________________
        Loop
     
    End With
        bd.Close: Set bd = Nothing
        Forms("Frm_Fondateur").Controls("Tbl_MontantLiquidePartgeHEMS_SFrm").Requery
        btAucun_Click
    Exit Sub
    OUMAR:
    MsgBox Err.Description, vbExclamation, Err.Number
    End Sub


    Je vous en remercie énormément.

    Maintenant je voudrais continuer avec cette autre partie la zone de liste déroulante du champ "NumBienArgentHEMS" que je voudrais filtrer avec la zone de liste déroulante indépendante "lst_NumBienArgentHEMS" dont voici le contenu sql
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    SELECT Tbl_HeritageEMSanogo_Argent.NumBienArgent, Tbl_HeritageEMSanogo_Argent.Montant_BienArgent, Tbl_HeritageEMSanogo_Argent.RowNum
    FROM Tbl_HeritageEMSanogo_Argent;
    .
    Je souhaite filtrer ce champ "NumBienArgentHEMS" seulement ce champ à chaque mise à jour de la zone de liste déroulante indépendante "lst_NumBienArgentHEMS".
    Pourriez vous me guider ?
    Pièce jointe BD
    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

  17. #17
    Expert éminent
    la liste déroulante NumBienArgentHEMS est un champ de la tableTbl_PartageBiensArgentEMS il faut mettre le mettre à jour à chaque modification.
    Dans la liste déroulante lst_NumBienArgentHEMS remplace le code actuel par celui-ci:
    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
    Private Sub lst_NumBienArgentHEMS_AfterUpdate()
    Dim rs As Recordset
    Set rs = Me.RecordsetClone
    rs.MoveFirst
    Echo False 'fige l'écran pendant la mise à jour
    Do Until rs.EOF
        rs.Edit
        rs.Fields("NumBienArgentHEMS") = Me.lst_NumBienArgentHEMS
        rs.Update
        rs.MoveNext
    Loop
    Me.Recalc
    Echo True
     
    End Sub

    il faut enlever le filtre du contenu de la liste déroulante NumBienArgentHEMS ainsi que la valeur par défaut:

    Quand on est derrière l'écran on n'a aucun clavier sous les mains ...

  18. #18
    Membre averti
    Bonsoir membres du forum,
    bonsoir tee_grandbois,

    Merci infiniment le code marche.
    Je continue le développement de l'application.
    Je vous retrouve bientôt.



    Cette partie est

    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

  19. #19
    Membre averti
    Bonsoir membres du forum,

    Je reviens avec les calculs suivants:
    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
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
     
    'Fonction Ramenant le montant de la part de chaque épouse
    'du défunt Elhadji Mahmoud Sanogo (Paix divine éternelle à
    'son âme).
    Public Function F_RamenantMontantPartChaqueEpouseEMS(MembrFamConc As Long, StatutMFEMS As Long, NumBienArg As Long) As Double
    On Error GoTo MOROBABOUMAR
    Dim bd As Database
    Dim rs As Recordset
    Dim sql As String
    Set bd = CurrentDb
    sql = "select (([Montant_BienArgent])*([Taux_PartPercu])) As PartMembrFamEMS from Req_Tbl_MontantLiquidePartgeHEMS_Epouse where MembresFamilleConcernesHEMS =" & MembrFamConc & _
    " and StatutMembreFamil=" & StatutMFEMS & " and NumBienArgentHEMS=" & NumBienArg & ""
     
    Set rs = bd.OpenRecordset(sql)
    If rs.EOF Or IsNull(rs.Fields("PartMembrFamEMS")) Then
       F_RamenantMontantPartChaqueEpouseEMS = 0
    Else
        F_RamenantMontantPartChaqueEpouseEMS = rs.Fields("PartMembrFamEMS") / 2 ' 1/8 *2 pour les deux épouses
    End If
    Exit Function
     
    MOROBABOUMAR:
        MsgBox "Erreur n° " & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Une erreur est survenue"
    End Function
     
    'Fonction Ramenant le montant de la part de chaque fille
    'du défunt Elhadji Mahmoud Sanogo (Paix divine éternelle à
    'son âme).
    Public Function F_RamenantMontantPartChaqueFilleEMS(MembrFamConc As Long, StatutMFEMS As Long, NumBienArg As Long) As Double
    On Error GoTo MOROBABOUMAR
    Dim bd As Database
    Dim rs As Recordset
    Dim sql As String
    Set bd = CurrentDb
    sql = "select (([Montant_BienArgent])*([Taux_PartPercu])) As PartMembrFilleEMS from Req_Tbl_MontantLiquidePartgeHEMS_FILLE where MembresFamilleConcernesHEMS =" & MembrFamConc & _
    " and StatutMembreFamil=" & StatutMFEMS & " and NumBienArgentHEMS=" & NumBienArg & ""
     
    Set rs = bd.OpenRecordset(sql)
    If rs.EOF Or IsNull(rs.Fields("PartMembrFilleEMS")) Then
       F_RamenantMontantPartChaqueFilleEMS = 0
    Else
        F_RamenantMontantPartChaqueFilleEMS = rs.Fields("PartMembrFilleEMS") / 7  '1/2 *7 pour les sept filles
    End If
    Exit Function
     
    MOROBABOUMAR:
        MsgBox "Erreur n° " & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Une erreur est survenue"
    End Function
     
     
    'Fonction Ramenant le montant de la part de chaque fils
    'du défunt Elhadji Mahmoud Sanogo (Paix divine éternelle à
    'son âme).
    Public Function F_RamenantMontantPartChaqueFilsEMS(MembrFamConc As Long, StatutMFEMS As Long, NumBienArg As Long) As Double
    On Error GoTo MOROBABOUMAR
    Dim bd As Database
    Dim rs As Recordset
    Dim sql As String
    Set bd = CurrentDb
    sql = "select ([Montant_BienArgent]*[Taux_PartPercu]) As PartMembrFilSEMS from Req_Tbl_MontantLiquidePartgeHEMS_FILS where MembresFamilleConcernesHEMS =" & MembrFamConc & _
    " and StatutMembreFamil=" & StatutMFEMS & " and NumBienArgentHEMS=" & NumBienArg & ""
     
    '-----------------------------------------------------------
    'permet de lever une erreur qu'on peut ensuite
    'traiter pour savoir ce qui a posé problème
    CurrentDb.Execute sql, dbFailOnError
    '_______________________________________
     
    Set rs = bd.OpenRecordset(sql)
    If rs.EOF Or IsNull(rs.Fields("PartMembrFilSEMS")) Then
       F_RamenantMontantPartChaqueFilsEMS = 0
    Else
        F_RamenantMontantPartChaqueFilsEMS = rs.Fields("PartMembrFilSEMS") / 9 '1 part pour les neuf fils
    End If
    Exit Function
     
    MOROBABOUMAR:
        MsgBox "Erreur n° " & Err.Number & vbCrLf & Err.Description, vbCritical + vbOKOnly, "Une erreur est survenue"
     
    End Function


    Le dernier code renvoie un message d'erreur:



    Mon objectif:
    1- obtenir la part de chaque épouse (2 épouses) qui est à 1/8 pour chacune d'elles de ce qu'a laisser comme montant liquide
    de l'héritage moins les dettes défunt,

    2 - obtenir la part de chaque fille (7 filles) qui est à 1/2 pour chacune d'elles de ce qu'a laisser comme montant liquide
    de l'héritage moins les dettes du défunt,

    3 - obtenir la part de chaque fils (9 fils) qui est à 1 part pour chacun d'eux de ce qu'a laisser comme montant liquide
    de l'héritage moins les dettes du défunt,




    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

  20. #20
    Expert éminent
    bonsoir,
    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    sql = "select ([Montant_BienArgent]*[Taux_PartPercu]) As PartMembrFilSEMS from Req_Tbl_MontantLiquidePartgeHEMS_FILS where MembresFamilleConcernesHEMS =" & MembrFamConc & _
    " and StatutMembreFamil=" & StatutMFEMS & " and NumBienArgentHEMS=" & NumBienArg & ""
     
    '-----------------------------------------------------------
    'permet de lever une erreur qu'on peut ensuite
    'traiter pour savoir ce qui a posé problème
    CurrentDb.Execute sql, dbFailOnError
    on ne peut pas exécuter une requête sélection avec la méthode Execute, il faut enlever cette instruction
    Quand on est derrière l'écran on n'a aucun clavier sous les mains ...