Private Sub visudoc_Click()
ShellExecute 0, "open", "P:\Budget_DB\sce_contrats\Visa_budget\" & Me.Id_affaire & ".pdf", vbNullString, vbNullString, 1
End Sub

Public Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

 
Option Compare Database
Option Explicit
 
Dim MonEtat as boolean
dim mObjet as ClassePerso
...

MonEtat = true
set mObjet = new ClassePerso

...
If MonEtat then
   call mObjet.fermer()
   do something
End if
...

Private Sub TxtRecherche_Change()
    Dim strFiltre As String
    Dim valRecherche As String
    Dim tempRecherche As String
 
    valRecherche = Me.TxtRecherche.Text
 
    If valRecherche = "" Then
        Me.Filter = ""
        Me.FilterOn = False
    Else
        ' GESTION DES ESPACES : remplace l'espace par un joker *
        tempRecherche = Replace(Me.TxtRecherche.Text, " ", "* ")
 
 strFiltre = "[Sous_Designation] LIKE '*" & tempRecherche & "*'"
 
        ' GESTION DES ACCENTS
        tempRecherche = Replace(tempRecherche, "a", "[aàâä]")
        tempRecherche = Replace(tempRecherche, "e", "[eéèêë]")
        tempRecherche = Replace(tempRecherche, "i", "[iîï]")
        tempRecherche = Replace(tempRecherche, "o", "[oôö]")
        tempRecherche = Replace(tempRecherche, "u", "[uùûü]")
        tempRecherche = Replace(tempRecherche, "c", "[cç]")
 
        strFiltre = "[Sous_Designation] LIKE '*" & tempRecherche & "*' OR " & _
                    "CStr([NumAutoSCmdSousDesign]) LIKE '*" & valRecherche & "*'"
 
        Me.Filter = strFiltre
        Me.FilterOn = True
 
        Me.TxtRecherche.SetFocus
        Me.TxtRecherche.SelStart = Len(valRecherche)
    End If
End Sub

 
' ==========================================================
' PROCEDURE DE CALCUL DE L'HERITAGE (CAS : EPOUSES + ENFANTS)
' ==========================================================
Private Sub btnCalculerPartage_Click()
    Dim db As DAO.Database
    Dim rsH As DAO.Recordset
    Dim rsCharges As DAO.Recordset
    Dim strSql As String
 
    ' Variables financières
    Dim mBrute As Double, mNette As Double, tCharges As Double, wassiyyah As Double
    Dim pEpouseTotale As Double, pFille As Double
    Dim nFils As Integer, nFilles As Integer, nEpouses As Integer
    Dim mFinal As Double, sFraction As String, sBase As String, idCalculID As Long
 
    On Error GoTo Err_Proc
    Set db = CurrentDb
 
    ' --- 1. RÉCUPÉRATION DES CHIFFRES (Table Tbl_Montant_Et_Charges) ---
    strSql = "SELECT * FROM Tbl_Montant_Et_Charges WHERE id_defunt=" & Me.id_defunt
    Set rsCharges = db.OpenRecordset(strSql)
 
    If rsCharges.EOF Then
        MsgBox "ERREUR : Aucune donnée financière trouvée pour ce défunt.", vbCritical
        rsCharges.Close: Exit Sub
    End If
 
    mBrute = Nz(rsCharges!Masse_Brute, 0)
    tCharges = Nz(rsCharges!Frais_Funeraires, 0) + Nz(rsCharges!Dettes, 0) + Nz(rsCharges!Pension_Alimentaire, 0)
    wassiyyah = Nz(rsCharges!Leg_Wassiyyah, 0)
    mNette = mBrute - tCharges - wassiyyah
    rsCharges.Close
 
    ' --- 2. COMPTAGE (Utilisation de id_defunt tel que vu sur l'image) ---
    ' Vérifiez que 7=Epouse, 5=Fils, 6=Fille dans votre table de référence
    nEpouses = DCount("*", "T_Heritier", "id_defunt=" & Me.id_defunt & " AND ID_LienFamille_Herit=7")
    nFils = DCount("*", "T_Heritier", "id_defunt=" & Me.id_defunt & " AND ID_LienFamille_Herit=5")
    nFilles = DCount("*", "T_Heritier", "id_defunt=" & Me.id_defunt & " AND ID_LienFamille_Herit=6")
 
    ' --- 3. NETTOYAGE DES ANCIENS CALCULS ---
    db.Execute "DELETE FROM T_Resultat WHERE id_heritier IN (SELECT id_heritier FROM T_Heritier WHERE id_defunt=" & Me.id_defunt & ")", dbFailOnError
    db.Execute "DELETE FROM T_Calcul_Synthese WHERE id_defunt=" & Me.id_defunt, dbFailOnError
 
    ' --- 4. ARCHIVAGE DANS T_CALCUL_SYNTHESE ---
    ' Str() transforme la virgule en point, évitant l'erreur "Trop peu de paramètres"
    strSql = "INSERT INTO T_Calcul_Synthese (id_defunt, date_calcul, masse_brute_calculee, total_charges_deduites, montant_wassiyyah, masse_nette_finale, nb_heritiers_total, statut_calcul) " & _
             "VALUES (" & Me.id_defunt & ", Now(), " & Str(mBrute) & ", " & Str(tCharges) & ", " & Str(wassiyyah) & ", " & Str(mNette) & ", " & (nFils + nFilles + nEpouses) & ", 'Validé')"
    db.Execute strSql, dbFailOnError
 
    idCalculID = db.OpenRecordset("SELECT @@IDENTITY").Fields(0)
 
    ' --- 5. CALCULS ISLAMIQUES (1/8 pour épouses, reste 2 pour 1 pour enfants) ---
    If nEpouses > 0 Then pEpouseTotale = mNette * (1 / 8) Else pEpouseTotale = 0
 
    Dim mResteEnfants As Double
    mResteEnfants = mNette - pEpouseTotale
 
    ' Calcul de la part d'une fille (base de calcul)
    If (nFils * 2 + nFilles) > 0 Then
        pFille = mResteEnfants / ((nFils * 2) + nFilles)
    Else
        pFille = 0
    End If
 
    ' --- 6. RÉPARTITION INDIVIDUELLE ---
    Set rsH = db.OpenRecordset("SELECT * FROM T_Heritier WHERE id_defunt=" & Me.id_defunt)
 
    Do While Not rsH.EOF
        Select Case rsH!ID_LienFamille_Herit
            Case 7 ' Épouses
                mFinal = pEpouseTotale / IIf(nEpouses > 0, nEpouses, 1)
                sFraction = "1/8 partagé": sBase = "Coran 4:12"
            Case 5 ' Fils
                mFinal = pFille * 2
                sFraction = "2 parts": sBase = "Ta'sib (2:1)"
            Case 6 ' Filles
                mFinal = pFille
                sFraction = "1 part": sBase = "Ta'sib (1:1)"
            Case Else
                mFinal = 0: sFraction = "N/A": sBase = "-"
        End Select
 
        strSql = "INSERT INTO T_Resultat (id_heritier, id_calcul, part_fraction, montant_calcule, base_legale) " & _
                 "VALUES (" & rsH!id_heritier & ", " & idCalculID & ", '" & sFraction & "', " & Str(mFinal) & ", '" & sBase & "')"
        db.Execute strSql, dbFailOnError
 
        rsH.MoveNext
    Loop
 
    MsgBox "Calcul terminé avec succès !", vbInformation, "EMS SUCCESSION"
 
Exit_Proc:
    On Error Resume Next
    If Not rsH Is Nothing Then rsH.Close
    Set db = Nothing
    Exit Sub
 
Err_Proc:
    MsgBox "Erreur : " & Err.Description, vbCritical
    Resume Exit_Proc
End Sub

Option Compare Database
Option Explicit
 
 
' ===========================================================================
' FONCTION MAÎTRE : Le chef d'orchestre qui redirige vers le bon calcul
' ===========================================================================
Public Function CalculerZakatUnifie(idU As Variant, idType As Variant, Quantite As Double, _
                                   Optional dateAcq As Variant, _
                                   Optional modeIrrig As String = "") As Variant
 
    ' 1. Sécurité : Si les informations essentielles sont manquantes
    If IsNull(idType) Or Quantite <= 0 Then
        CalculerZakatUnifie = "Saisie incomplète"
        Exit Function
    End If
 
    ' 2. Aiguillage selon l'ID de votre table T_Types_Biens
    Select Case idType
        Case 1, 2, 7 ' Argent (1), Or (2) et Marchandises (7)
            CalculerZakatUnifie = CalculerZakatMonetaireNet(idU, Quantite)
 
        Case 3 ' Moutons / Chèvres
            CalculerZakatUnifie = CalculZakatOvins(CInt(Quantite))
 
        Case 4 ' Vaches / Boeufs
            CalculerZakatUnifie = CalculZakatBovins(CInt(Quantite))
 
        Case 5 ' Récoltes (Céréales / Fruits)
            CalculerZakatUnifie = CalculerZakatAgricole(Quantite, modeIrrig)
 
        Case 6 ' Chameaux
            CalculerZakatUnifie = CalculZakatCamelins(CInt(Quantite))
 
        Case Else
            CalculerZakatUnifie = "ID [" & idType & "] non configuré"
    End Select
End Function
 
Public Function CalculZakatOvins(nbTetes As Integer) As String
    Select Case nbTetes
        Case 0 To 39: CalculZakatOvins = "Rien (Nisab non atteint)"
        Case 40 To 120: CalculZakatOvins = "1 mouton/chèvre"
        Case 121 To 200: CalculZakatOvins = "2 moutons/chèvres"
        Case 201 To 399: CalculZakatOvins = "3 moutons/chèvres"
        Case Is >= 400:
            ' 1 bête par centaine supplémentaire
            CalculZakatOvins = (nbTetes \ 100) & " moutons/chèvres"
    End Select
End Function
 
 
' ===========================================================================
' CALCULS DU BÉTAIL (BOVINS, OVINS, CAMELINS)
' ===========================================================================
Public Function CalculZakatBovins(nbTetes As Integer) As String
    Dim nbTabi As Integer, nbMusinna As Integer
    Select Case nbTetes
        Case 0 To 29: CalculZakatBovins = "Rien (Nisab: 30)"
        Case 30 To 39: CalculZakatBovins = "1 veau d'un an (Tabi')"
        Case 40 To 59: CalculZakatBovins = "1 vache de 2 ans (Musinnah)"
        Case 60 To 69: CalculZakatBovins = "2 veaux d'un an (Tabi')"
        Case Is >= 70
            nbMusinna = nbTetes \ 40
            nbTabi = (nbTetes Mod 40) \ 30
            CalculZakatBovins = nbMusinna & " Musinnah et " & nbTabi & " Tabi'"
    End Select
End Function
 
 
Public Function CalculZakatRecolte(poidsKG As Double, ModeIrrigation As String) As Double
    If poidsKG < 653 Then
        CalculZakatRecolte = 0
    Else
        Select Case ModeIrrigation
            Case "Pluie": CalculZakatRecolte = poidsKG * 0.1
            Case "Artificiel": CalculZakatRecolte = poidsKG * 0.05
            Case Else: CalculZakatRecolte = poidsKG * 0.075
        End Select
    End If
End Function
 
Public Function CalculZakatCamelins(nbTetes As Integer) As String
    Select Case nbTetes
        Case 0 To 4: CalculZakatCamelins = "Rien"
        Case 5 To 9: CalculZakatCamelins = "1 mouton"
        Case 10 To 14: CalculZakatCamelins = "2 moutons"
        Case 15 To 19: CalculZakatCamelins = "3 moutons"
        Case 20 To 24: CalculZakatCamelins = "4 moutons"
        Case 25 To 35: CalculZakatCamelins = "1 jeune chamelle (1 an - Bint Makhad)"
        Case 36 To 45: CalculZakatCamelins = "1 chamelle (2 ans - Bint Labun)"
        Case 46 To 60: CalculZakatCamelins = "1 chamelle (3 ans - Hiqqah)"
        Case 61 To 75: CalculZakatCamelins = "1 chamelle (4 ans - Jadh'ah)"
        Case 76 To 90: CalculZakatCamelins = "2 chamelles (2 ans - Bint Labun)"
        Case 91 To 120: CalculZakatCamelins = "2 chamelles (3 ans - Hiqqah)"
        ' Remplacez la ligne Case Is > 120 par ceci :
        Case Is > 120
        Dim n40 As Integer, n50 As Integer
        ' Règle : 1 Bint Labun par 40 OU 1 Hiqqah par 50
        ' On calcule le nombre de groupes de 50 et le reste par 40
        n50 = nbTetes \ 50
        n40 = (nbTetes Mod 50) \ 40 ' Simplification courante
 
        ' Un calcul plus précis peut être complexe, mais voici une réponse standard :
        CalculZakatCamelins = "Règle des 40/50 applicable (" & n50 & " Hiqqah et " & n40 & " Bint Labun)"
        End Select
End Function
 
 
' ===========================================================================
' CALCULS MONÉTAIRES (AVEC DÉDUCTION DES DETTES)
' ===========================================================================
Public Function CalculerZakatMonetaireNet(idU As Variant, montantBrut As Double) As String
    Dim totalDettes As Double
    Dim montantNet As Double
 
    ' Récupération des dettes de l'utilisateur dans T_Dettes
    If Not IsNull(idU) Then
        totalDettes = Nz(DSum("Montant_Total", "T_Dettes", "ID_User = " & idU), 0)
    Else
        totalDettes = 0
    End If
 
    montantNet = montantBrut - totalDettes
 
    If montantNet <= 0 Then
        CalculerZakatMonetaireNet = "0,00 (Dettes > Avoirs)"
    Else
        ' Taux légal de 2,5%
        CalculerZakatMonetaireNet = Format(montantNet * 0.025, "#,##0.00") & " (Net à 2,5%)"
    End If
End Function
 
 
' ===========================================================================
' CALCUL AGRICOLE
' ===========================================================================
Public Function CalculerZakatAgricole(Quantite As Double, modeIrrig As String) As String
    Dim res As Double
    Select Case modeIrrig
        Case "Pluie": res = Quantite * 0.1: CalculerZakatAgricole = Format(res, "#,##0") & " (Dû à 10%)"
        Case "Artificiel": res = Quantite * 0.05: CalculerZakatAgricole = Format(res, "#,##0") & " (Dû à 5%)"
        Case "Mixte": res = Quantite * 0.075: CalculerZakatAgricole = Format(res, "#,##0") & " (Dû à 7,5%)"
        Case Else: CalculerZakatAgricole = "Précisez l'irrigation"
    End Select
End Function
 
 
 
' ===========================================================================
' NOTES EXPLICATIVES DYNAMIQUES
' ===========================================================================
Public Function ObtenirNoteZakat(idType As Variant) As String
    Select Case idType
        Case 1, 2, 7: ObtenirNoteZakat = "Taux de 2,5% après déduction des dettes. Nisab : ~85g d'or."
        Case 3: ObtenirNoteZakat = "Nisab: 40 têtes. 1 bête de 40 à 120, puis 1 par centaine."
        Case 4: ObtenirNoteZakat = "Nisab: 30 têtes. 1 veau (1 an) par 30 ou 1 vache (2 ans) par 40."
        Case 5: ObtenirNoteZakat = "Nisab: 653kg. Taux variable (5%, 7,5% ou 10%) selon l'irrigation."
        Case 6: ObtenirNoteZakat = "Nisab: 5 têtes. Barème spécifique alternant moutons et chamelles."
        Case Else: ObtenirNoteZakat = "Sélectionnez un bien pour voir la règle."
    End Select
End Function

Option Compare Database
Option Explicit
 
Private Sub Date_Acquisition_GotFocus()
GererAffichageIrrigation
End Sub
 
Private Sub Form_Current()
    ' Affiche la note dès qu'on change de ligne (enregistrement)
    If Not IsNull(Me.Type_Bien) Then
        Type_Bien_AfterUpdate
    End If
End Sub
 
Private Sub CmdFrm_Configuration_Click()
DoCmd.OpenForm "Frm_Configuration", , , , , acDialog
End Sub
 
Private Sub Date_Acquisition_AfterUpdate()
    ' On relance simplement le calcul global
    ' Cela permet de vérifier instantanément si le Hawl (354j) est atteint
    Quantite_AfterUpdate
End Sub
 
Private Sub ID_User_AfterUpdate()
' --- À AJOUTER AU DÉBUT DE CHAQUE PROCÉDURE ---
If IsNull(Me.ID_User) Or IsNull(Me.Type_Bien) Or IsNull(Me.Quantite) Then
    Me.TxtResultat = "Saisie en cours..."
    Exit Sub
End If
 
End Sub
 
Private Sub Mode_Irrigation_AfterUpdate()
    ' On relance le calcul global dès qu'on change l'irrigation
    Me.TxtResultat = CalculerZakatUnifie(Me.ID_User, Me.Type_Bien, Me.Quantite, Me.Date_Acquisition, Nz(Me.Mode_Irrigation, ""))
End Sub
 
Private Sub Mode_Irrigation_GotFocus()
    GererAffichageIrrigation
End Sub
 
Private Sub Quantite_AfterUpdate()
    ' On force l'enregistrement
    If Me.Dirty Then Me.Dirty = False
 
    ' 1. On calcule le résultat (ce que nous avons déjà fait)
    Me.TxtResultat = CalculerZakatUnifie(Nz(Me.Type_Bien, 0), Nz(Me.Quantite, 0), Me.Date_Acquisition, Nz(Me.Mode_Irrigation, ""))
 
    ' 2. On met à jour la note explicative automatiquement
    Me.TxtNote = ObtenirNoteZakat(Nz(Me.Type_Bien, 0))
End Sub
 
Private Sub GererAffichageIrrigation()
    ' On vérifie si le type de bien actuel est bien "Récoltes" (ID 5)
    If Nz(Me.Type_Bien, 0) = 5 Then
        ' On déverrouille et on change la couleur pour montrer que c'est actif
        Me.Mode_Irrigation.Locked = False
        Me.Mode_Irrigation.Enabled = True
        Me.Mode_Irrigation.BackColor = vbWhite
    Else
        ' On verrouille pour éviter les erreurs sur les autres types de biens
        Me.Mode_Irrigation.Locked = True
        Me.Mode_Irrigation.Enabled = False
        Me.Mode_Irrigation.BackColor = 14211288 ' Gris clair
    End If
End Sub
 
' --- SÉCURITÉ POUR ÉVITER LES MSGBOX D'ERREUR ---
Private Sub VerifierSaisieComplete()
    ' Si l'un des trois champs est vide, on affiche un message d'attente
    If IsNull(Me.ID_User) Or IsNull(Me.Type_Bien) Or IsNull(Me.Quantite) Then
        Me.TxtResultat = "Saisie en cours..."
        Exit Sub
    End If
End Sub
 
 
 
Private Sub Type_Bien_AfterUpdate()
    ' 1. Sécurité
    If IsNull(Me.ID_User) Or IsNull(Me.Type_Bien) Or IsNull(Me.Quantite) Then
        ' On gère quand même l'affichage du champ irrigation
        If Nz(Me.Type_Bien, 0) = 5 Then Me.Mode_Irrigation.Visible = True Else Me.Mode_Irrigation.Visible = False
        Exit Sub
    End If
 
    ' 2. Enregistrement
    If Me.Dirty Then Me.Dirty = False
 
    ' 3. Affichage dynamique de l'irrigation
    If Nz(Me.Type_Bien, 0) = 5 Then
        Me.Mode_Irrigation.Visible = True
        Me.Mode_Irrigation.Enabled = True
    Else
        Me.Mode_Irrigation.Visible = False
        Me.Mode_Irrigation.Value = Null
    End If
 
    ' 4. Calcul et Note
    Me.TxtResultat = CalculerZakatUnifie(Me.ID_User, Me.Type_Bien, Me.Quantite, Me.Date_Acquisition, Nz(Me.Mode_Irrigation, ""))
    Me.TxtNote = ObtenirNoteZakat(Nz(Me.Type_Bien, 0))
End Sub