Option Explicit

' Déclaration des variables globales

Public ws_members As Worksheet
Public ws_cotisations As Worksheet
Public ws_depenses As Worksheet
Public wsReport As Worksheet
Public mois As Integer
Public annee As Integer
Private Const VERSION As String = "1.0.0"

' Initialisation des feuilles de travail

Sub InitializeWorksheets()
On Error Resume Next
Set ws_members = [Link]("Membres")
Set ws_cotisations = [Link]("Cotisations")
Set ws_depenses = [Link]("Depenses")
On Error GoTo 0

' Vérifier si les feuilles existent

If ws_members Is Nothing Or ws_cotisations Is Nothing Or ws_depenses Is Nothing Then
MsgBox "Une ou plusieurs feuilles de travail sont manquantes. Veuillez vérifier les
noms des feuilles.", vbCritical
Exit Sub
End If

' Vérifier et supprimer les anciennes feuilles de rapport

Dim ws As Worksheet
For Each ws In [Link]
If Left([Link], 8) = "Rapport_" Then
[Link] = False
[Link]
[Link] = True
End If
Next ws

' Créer la nouvelle feuille de rapport

Dim wsName As String
wsName = "Rapport_" & Format(Now, "yyyymmdd_hhmmss")

[Link](After:=[Link]([Link])).Name
= wsName
Set wsReport = [Link](wsName)

' Supprimer tous les graphiques existants

Dim ChartObj As ChartObject
For Each ChartObj In [Link]
[Link]
Next ChartObj

' Nettoyer le contenu de la feuille

[Link]
[Link]
End Sub

Function MembreExiste(searchStr As String) As Boolean

Dim lastRow As Long
 lastRow = ws_members.Cells([Link], 1).End(xlUp).row

Dim i As Long
For i = 2 To lastRow
If ws_members.Cells(i, 1).Value = searchStr Or ws_members.Cells(i, 3).Value =
searchStr Then
MembreExiste = True
Exit Function
End If
Next i

MembreExiste = False
End Function

' Fonction pour générer automatiquement un ID

Function GenererNouveauID() As String
Dim lastRow As Long
Dim lastID As Long

lastRow = ws_members.Cells([Link], 1).End(xlUp).row

If lastRow = 1 Then
' Si aucun membre n'existe encore, commencer à 1
GenererNouveauID = "MBR001"
Else
' Prendre le dernier ID et incrémenter
lastID = CLng(Right(ws_members.Cells(lastRow, 1).Value, 3))
GenererNouveauID = "MBR" & Format(lastID + 1, "000")
End If
End Function

' Fonction modifiée pour ajouter un nouveau membre

Sub AjouterMembre()
Dim nom As String
Dim prenom As String
Dim telephone As String
Dim email As String
Dim dateAdhesion As Date
Dim id As String

' Générer automatiquement l'ID

id = GenererNouveauID()

' Saisie des informations

nom = InputBox("Entrez le nom:", "Nouveau Membre")
If nom = "" Then Exit Sub

prenom = InputBox("Entrez le prénom:", "Nouveau Membre")

If prenom = "" Then Exit Sub

telephone = InputBox("Entrez le numéro de téléphone:", "Nouveau Membre")

email = InputBox("Entrez l'email:", "Nouveau Membre")
dateAdhesion = Date

' Ajouter à la feuille des membres

Dim lastRow As Long
lastRow = ws_members.Cells([Link], 1).End(xlUp).row + 1
 With ws_members
.Cells(lastRow, 1) = id
.Cells(lastRow, 2) = nom
.Cells(lastRow, 3) = prenom
.Cells(lastRow, 4) = telephone
.Cells(lastRow, 5) = email
.Cells(lastRow, 6) = dateAdhesion
End With

MsgBox "Membre ajouté avec succès! ID: " & id, vbInformation
End Sub

Sub EnregistrerCotisation()
Dim dateCotisation As Date
Dim id As String
Dim montantBrut As Double
Dim montantNet As Double
Dim frais As Double

' Saisie des informations

dateCotisation = Date

id = InputBox("Entrez l'ID ou le prénom du membre:", "Nouvelle Cotisation")

If id = "" Then Exit Sub

' Vérifier si le membre existe

If Not MembreExiste(id) Then
MsgBox "Ce membre n'existe pas!", vbExclamation
Exit Sub
End If

montantBrut = CDbl(InputBox("Entrez le montant brut:", "Nouvelle Cotisation"))

If montantBrut <= 0 Then Exit Sub

' Calculer les frais à 1% du montant brut

frais = montantBrut * 0.01
montantNet = montantBrut - frais

' Ajouter à la feuille des cotisations

Dim lastRow As Long
lastRow = ws_cotisations.Cells([Link], 1).End(xlUp).row + 1

With ws_cotisations
.Cells(lastRow, 1) = dateCotisation
.Cells(lastRow, 2) = id
.Cells(lastRow, 3) = montantBrut
.Cells(lastRow, 4) = frais
.Cells(lastRow, 5) = montantNet
End With

MsgBox "Cotisation enregistrée avec succès!", vbInformation

End Sub

' Fonction pour enregistrer une dépense

Sub EnregistrerDepense()
Dim dateDepense As Date
 Dim description As String
Dim montant As Double

' Saisie des informations

dateDepense = Date

description = InputBox("Entrez la description de la dépense:", "Nouvelle Dépense")

If description = "" Then Exit Sub

montant = CDbl(InputBox("Entrez le montant:", "Nouvelle Dépense"))

If montant <= 0 Then Exit Sub

' Ajouter à la feuille des dépenses

Dim lastRow As Long
lastRow = ws_depenses.Cells([Link], 1).End(xlUp).row + 1

With ws_depenses
.Cells(lastRow, 1) = dateDepense
.Cells(lastRow, 2) = description
.Cells(lastRow, 3) = montant
End With

MsgBox "Dépense enregistrée avec succès!", vbInformation

End Sub

Sub ListeMembresNonContribuants()
' Initialisation
Call InitializeWorksheets

' Demander le mois et l'année

mois = CInt(InputBox("Entrez le numéro du mois (1-12):", "Membres Non Contribuants"))
If mois < 1 Or mois > 12 Then Exit Sub

annee = CInt(InputBox("Entrez l'année:", "Membres Non Contribuants"))

If annee < 2000 Then Exit Sub

' Créer un dictionnaire pour stocker les membres qui ont contribué
Dim dictContribuants As Object
Set dictContribuants = CreateObject("[Link]")

' Parcourir toutes les cotisations du mois

Dim lastCotRow As Long
lastCotRow = ws_cotisations.Cells([Link], 1).End(xlUp).row

' Enregistrer les ID des membres qui ont contribué

Dim i As Long
For i = 2 To lastCotRow
If Month(ws_cotisations.Cells(i, 1)) = mois And Year(ws_cotisations.Cells(i, 1)) =
annee Then
dictContribuants(ws_cotisations.Cells(i, 2).Value) = True
End If
Next i

' Créer une nouvelle feuille pour le rapport

Dim wsName As String
wsName = "NonContribuants_" & Format(Now, "yyyymmdd_hhmmss")
 ' Vérifier si la feuille existe déjà et la supprimer si c'est le cas
On Error Resume Next
[Link] = False
[Link]("NonContribuants").Delete
[Link] = True
On Error GoTo 0

' Créer la nouvelle feuille avec un nom fixe

[Link](After:=[Link]([Link])).Name
= "NonContribuants"
Set wsReport = [Link]("NonContribuants")

With wsReport
' Titre' En-têtes du rapport avec style amélioré
.Range("A1:F1").Merge
.Range("A2:F2").Merge
ApplyTitleStyle .Range("A1:F1"), RGB(155, 194, 230)
.Range("A2").HorizontalAlignment = xlCenter

.Cells(1, 1) = "LISTE DES MEMBRES NON CONTRIBUANTS"

.Cells(2, 1) = "Période: " & MonthName(mois) & " " & annee
.Range("A1:A2").[Link] = True

' En-têtes
.Cells(4, 1) = "ID"
.Cells(4, 2) = "Nom"
.Cells(4, 3) = "Prénom"
.Cells(4, 4) = "Téléphone"
.Cells(4, 5) = "Email"
.Range("A4:E4").[Link] = True

' Parcourir tous les membres

Dim lastMemberRow As Long
lastMemberRow = ws_members.Cells([Link], 1).End(xlUp).row

Dim row As Long

row = 5

For i = 2 To lastMemberRow
' Si le membre n'a pas contribué ce mois-ci
If Not [Link](ws_members.Cells(i, 1).Value) Then
.Cells(row, 1) = ws_members.Cells(i, 1).Value
.Cells(row, 2) = ws_members.Cells(i, 2).Value
.Cells(row, 3) = ws_members.Cells(i, 3).Value
.Cells(row, 4) = ws_members.Cells(i, 4).Value
.Cells(row, 5) = ws_members.Cells(i, 5).Value
row = row + 1
End If
Next i

' Statistiques
.Cells(row + 1, 1) = "Nombre total de membres:"
.Cells(row + 1, 2) = lastMemberRow - 1

.Cells(row + 2, 1) = "Nombre de non contribuants:"

.Cells(row + 2, 2) = row - 5
 .Cells(row + 3, 1) = "Taux de non contribution:"
.Cells(row + 3, 2) = Format((row - 5) / (lastMemberRow - 1), "0.0%")

' Formatage
.Range("A4:E" & row - 1).[Link] = xlContinuous
.Range("A" & row + 1 & ":B" & row + 3).[Link] = True
.Columns("A:E").AutoFit
End With

MsgBox "Liste des membres non contribuants générée avec succès!", vbInformation
End Sub
Sub RechercherMembre()
Dim searchStr As String
Dim ws As Worksheet
Dim lastRow As Long
Dim found As Boolean
Dim resultSheet As Worksheet
Dim i As Long
Set ws = ws_members
searchStr = InputBox("Entrez le nom, prénom ou ID du membre:", "Recherche de membre")
If searchStr = "" Then Exit Sub

' Créer/Réinitialiser la feuille de résultats

On Error Resume Next
[Link]("Résultats_Recherche").Delete
Set resultSheet = [Link]
[Link] = "Résultats_Recherche"
On Error GoTo 0

' En-têtes
With resultSheet
.Cells(1, 1) = "ID"
.Cells(1, 2) = "Nom"
.Cells(1, 3) = "Prénom"
.Cells(1, 4) = "Téléphone"
.Cells(1, 5) = "Email"
.Cells(1, 6) = "Date d'adhésion"
.Cells(1, 7) = "Total cotisations"
.Range("A1:G1").[Link] = True
End With

lastRow = [Link]([Link], 1).End(xlUp).row

Dim resultRow As Long
resultRow = 2
found = False

' Recherche
For i = 2 To lastRow
If InStr(1, [Link](i, 1).Text, searchStr, vbTextCompare) > 0 Or _
InStr(1, [Link](i, 2).Text, searchStr, vbTextCompare) > 0 Or _
InStr(1, [Link](i, 3).Text, searchStr, vbTextCompare) > 0 Then

' Copier les informations du membre

[Link]([Link](i, 1), [Link](i, 6)).Copy _
[Link]([Link](resultRow, 1),
[Link](resultRow, 6))
 ' Calculer le total des cotisations
[Link](resultRow, 7) = CalculerTotalCotisations([Link](i, 1).Value)

resultRow = resultRow + 1
found = True
End If
Next i

If found Then
' Formatage
With resultSheet
.Columns("A:G").AutoFit
.Range("A1:G" & resultRow - 1).[Link] = xlContinuous
.Range("G2:G" & resultRow - 1).NumberFormat = "#,##0 CFA"
End With
MsgBox "Recherche terminée. " & (resultRow - 2) & " résultat(s) trouvé(s).",
vbInformation
Else
MsgBox "Aucun résultat trouvé.", vbInformation
[Link]
End If
End Sub

Function CalculerTotalCotisations(membreID As String) As Double

Dim total As Double
Dim lastRow As Long
Dim i As Long
lastRow = ws_cotisations.Cells([Link], 1).End(xlUp).row

For i = 2 To lastRow
If ws_cotisations.Cells(i, 2).Value = membreID Then
total = total + ws_cotisations.Cells(i, 5).Value
End If
Next i

CalculerTotalCotisations = total
End Function
Sub CreerRappelCotisation()
Dim wsMail As Worksheet
Dim ws_members As Worksheet
Dim ws_cotisations As Worksheet
Dim lastRow As Long
Dim moisActuel As Integer
Dim anneeActuelle As Integer
Dim i As Long
Dim row As Long
Dim derniereCot As Date
Dim moisManques As String
Dim moisDebut As Integer
Dim anneeDebut As Integer

' Définir les feuilles de travail

Set ws_members = [Link]("Membres")
Set ws_cotisations = [Link]("Cotisations")

moisActuel = Month(Date)
 anneeActuelle = Year(Date)

moisDebut = 11 ' Novembre

anneeDebut = 2024 ' Ou l'année de début des cotisations

' Créer/Réinitialiser la feuille des rappels

On Error Resume Next
[Link]("Rappels").Delete
Set wsMail = [Link]
[Link] = "Rappels"
On Error GoTo 0

With wsMail
' En-têtes
.Cells(1, 1) = "ID"
.Cells(1, 2) = "Nom"
.Cells(1, 3) = "Prénom"
.Cells(1, 4) = "Email"
.Cells(1, 5) = "Téléphone"
.Cells(1, 6) = "Dernière cotisation"
.Cells(1, 7) = "Message"
.Cells(1, 8) = "Mois Manqués"
.Range("A1:H1").[Link] = True

row = 2

' Parcourir tous les membres

lastRow = ws_members.Cells([Link], 1).End(xlUp).row

For i = 2 To lastRow
derniereCot = ObtenirDerniereCotisation(ws_members.Cells(i, 1).Value)
moisManques = ""

' Vérifier les mois manqués depuis novembre 2024

Dim mois As Integer
Dim annee As Integer
For annee = anneeDebut To anneeActuelle
For mois = IIf(annee = anneeDebut, moisDebut, 1) To IIf(annee =
anneeActuelle, moisActuel, 12)
If Not CotisationExiste(ws_members.Cells(i, 1).Value, mois, annee)
Then
If moisManques <> "" Then moisManques = moisManques & ", "
moisManques = moisManques & MonthName(mois) & " " & annee
End If
Next mois
Next annee

' Si pas de cotisation ce mois-ci ou mois manqués

If Month(derniereCot) <> moisActuel Or Year(derniereCot) <> anneeActuelle Or
moisManques <> "" Then
.Cells(row, 1) = ws_members.Cells(i, 1).Value
.Cells(row, 2) = ws_members.Cells(i, 2).Value
.Cells(row, 3) = ws_members.Cells(i, 3).Value
.Cells(row, 4) = ws_members.Cells(i, 5).Value
.Cells(row, 5) = ws_members.Cells(i, 4).Value
.Cells(row, 6) = derniereCot
.Cells(row, 8) = moisManques
 ' Générer message personnalisé avec les mois manqués
.Cells(row, 7) = "Cher(e) " & ws_members.Cells(i, 3).Value & "," & vbNewLine
&_
"Nous souhaitons vous rappeler que votre contribution à
notre *Caisse de solidarité familiale Zouria Goni Bello* pour le mois de *" & _
MonthName(moisActuel) & " " & anneeActuelle & _
"* n'a pas encore été enregistrée. Votre engagement est
essentiel pour soutenir nos actions de solidarité. Nous vous remercions d'avance pour votre
contribution." & vbNewLine & _
"*Dernière contribution* : " & Format(derniereCot,
"dd/mm/yyyy") & vbNewLine & _
"*Mois manqués* : " & moisManques

row = row + 1
End If
Next i

' Formatage
.Columns("A:H").AutoFit
.Range("A1:H" & row - 1).[Link] = xlContinuous
End With

MsgBox row - 2 & " rappels générés.", vbInformation

End Sub

Function CotisationExiste(membreID As String, mois As Integer, annee As Integer) As

Boolean
Dim lastRow As Long
Dim i As Long
lastRow = ws_cotisations.Cells([Link], 1).End(xlUp).row
CotisationExiste = False

For i = 2 To lastRow
If ws_cotisations.Cells(i, 2).Value = membreID And _
Month(ws_cotisations.Cells(i, 1).Value) = mois And _
Year(ws_cotisations.Cells(i, 1).Value) = annee Then
CotisationExiste = True
Exit Function
End If
Next i
End Function
Function ObtenirDerniereCotisation(membreID As String) As Date
Dim lastRow As Long
Dim derniereCot As Date
Dim i As Long
Set ws_cotisations = [Link]("Cotisations") ' Assurez-vous que cette feuille
existe

lastRow = ws_cotisations.Cells([Link], 1).End(xlUp).row

derniereCot = DateSerial(1900, 1, 1) ' Date par défaut très ancienne

For i = 2 To lastRow
If ws_cotisations.Cells(i, 2).Value = membreID Then
If ws_cotisations.Cells(i, 1).Value > derniereCot Then
derniereCot = ws_cotisations.Cells(i, 1).Value
End If
 End If
Next i

ObtenirDerniereCotisation = derniereCot
End Function
Sub AnalyseFinanciere()
Dim wsStats As Worksheet
Dim ws_cotisations As Worksheet 'Ajout de la déclaration
Dim totalCotisations As Double
Dim totalDepenses As Double
Dim dictCotisationsMensuelles As Object
Dim mois As Integer
Dim annee As Integer
Dim dernierMois As Integer
Dim derniereAnnee As Integer
Dim i As Long
Dim lastCotRow As Long
Dim lastDepRow As Long
Dim row As Long
Dim cht As ChartObject
Dim appreciation As String
Dim cle As Variant

'Initialisation des feuilles de calcul

Set ws_cotisations = [Link]("Cotisations") 'Ajout de l'initialisation

' Créer/Réinitialiser la feuille de statistiques

On Error Resume Next
[Link]("AnalyseFinanciere").Delete
Set wsStats = [Link]
[Link] = "AnalyseFinanciere"
On Error GoTo 0

With wsStats
' Titre
.Cells(1, 1) = "ANALYSE FINANCIÈRE"
.Range("A1:A1").[Link] = True

' Statistiques des cotisations et dépenses

.Cells(3, 1) = "Total des cotisations:"
.Cells(4, 1) = "Total des dépenses:"
.Cells(5, 1) = "Solde actuel:"

' Calculer les totaux

totalCotisations = CalculerTotalCotisationsGlobal()
totalDepenses = CalculerTotalDepensesGlobal()

.Cells(3, 2) = totalCotisations
.Cells(4, 2) = totalDepenses
.Cells(5, 2) = totalCotisations - totalDepenses

' Formatage des nombres en monnaie

.Range("B3:B5").NumberFormat = "#,##0 CFA"

' Section des cotisations mensuelles

.Cells(7, 1) = "COTISATIONS MENSUELLES"
.Range("A7:B7").[Link] = True
 ' Créer un dictionnaire pour stocker les cotisations mensuelles
Set dictCotisationsMensuelles = CreateObject("[Link]")

' Parcourir toutes les cotisations pour remplir le dictionnaire

lastCotRow = ws_cotisations.Cells(ws_cotisations.[Link], 1).End(xlUp).row
For i = 2 To lastCotRow
mois = Month(ws_cotisations.Cells(i, 1).Value)
annee = Year(ws_cotisations.Cells(i, 1).Value)
Dim cleTemp As String
cleTemp = annee & "-" & Format(mois, "00")

If [Link](cleTemp) Then
dictCotisationsMensuelles(cleTemp) = dictCotisationsMensuelles(cleTemp)
+ ws_cotisations.Cells(i, 5).Value
Else
[Link] cleTemp, ws_cotisations.Cells(i, 5).Value
End If
Next i

' Écrire les cotisations mensuelles dans la feuille

row = 8
For Each cle In [Link]
.Cells(row, 1) = cle
.Cells(row, 2) = dictCotisationsMensuelles(cle)
.Cells(row, 2).NumberFormat = "#0 CFA"
row = row + 1
Next cle

' Créer un graphique en courbe pour les cotisations mensuelles

Set cht = .[Link](Left:=.Range("D2").Left, Top:=.Range("D2").Top,
Width:=395, Height:=250)
With [Link]
.ChartType = xlLine
.SetSourceData Source:=[Link]("A8:B" & row - 1)
.HasTitle = True
.[Link] = "Évolution des Cotisations Mensuelles"
.Axes(xlValue).HasTitle = True
.Axes(xlValue).[Link] = "Montant (CFA)"
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).[Link] = "Mois"
End With

' Appréciation de l'évolution de la caisse

appreciation = "Appréciation de l'évolution de la caisse :" & vbCrLf

' Comparer les cotisations du dernier mois avec la moyenne

Dim dernierMoisCotisation As Double
Dim moyenneCotisations As Double
Dim nbMois As Integer

nbMois = [Link]
moyenneCotisations = totalCotisations / nbMois

' Récupérer la dernière clé (dernier mois)

Dim dernierCle As String
dernierCle = [Link]()([Link] - 1)
 dernierMoisCotisation = dictCotisationsMensuelles(dernierCle)

If dernierMoisCotisation > moyenneCotisations Then

appreciation = appreciation & "Les cotisations du dernier mois (" & dernierCle & ")
sont supérieures à la moyenne mensuelle." & vbCrLf
ElseIf dernierMoisCotisation < moyenneCotisations Then
appreciation = appreciation & "Les cotisations du dernier mois (" & dernierCle & ")
sont inférieures à la moyenne mensuelle." & vbCrLf
Else
appreciation = appreciation & "Les cotisations du dernier mois (" & dernierCle & ")
sont égales à la moyenne mensuelle." & vbCrLf
End If

' Ajouter l'appréciation dans la feuille

.Cells(row + 2, 1) = "APPRÉCIATION"
.Cells(row + 3, 1) = appreciation
.Range("A" & row + 2 & ":A" & row + 3).[Link] = True

' Formatage final

.Columns("A:B").AutoFit
.Range("A1:B" & row + 3).[Link] = xlContinuous
End With

MsgBox "Analyse financière générée avec succès!", vbInformation

End Sub

Function CalculerTotalCotisationsGlobal() As Double

Dim total As Double
Dim lastRow As Long
Dim i As Long
Dim ws_cotisations As Worksheet

'Définir la feuille de cotisations

Set ws_cotisations = [Link]("Cotisations") 'Assurez-vous que
"Cotisations" est le bon nom de votre feuille

With ws_cotisations
lastRow = .Cells(.[Link], 1).End(xlUp).row
For i = 2 To lastRow
total = total + .Cells(i, 5).Value
Next i
End With

CalculerTotalCotisationsGlobal = total
End Function

Function CalculerTotalDepensesGlobal() As Double

Dim total As Double
Dim lastRow As Long
Dim i As Long
Dim ws_depenses As Worksheet

Set ws_depenses = [Link]("Depenses")

With ws_depenses
lastRow = .Cells(.[Link], 1).End(xlUp).row
 'Ligne de débogage
MsgBox "Nombre de lignes trouvées : " & lastRow

For i = 2 To lastRow
total = total + .Cells(i, 3).Value
'Ligne de débogage optionnelle
[Link] "Ligne " & i & ": " & .Cells(i, 3).Value
Next i
End With

CalculerTotalDepensesGlobal = total
End Function
Sub GenererRapportMensuel()
Dim wsReport As Worksheet
Dim ws_cotisations As Worksheet
Dim ws_depenses As Worksheet
Dim ws_members As Worksheet
Dim mois As Integer
Dim annee As Integer
Dim nbMembres As Long
Dim nbCotisations As Long
Dim lastRow As Long
Dim i As Long
Dim dictCont As Object
Dim memberId As Variant
Dim lastMemberRow As Long
Dim j As Long
Dim row As Long
Dim lastCotRow As Long
Dim lastDepRow As Long
Dim startDepRow As Long
Dim soldePrecedent As Double
Dim totalContributions As Range
Dim totalDepenses As Range
Dim rowSoldePrecedent As Long
Dim rowContributions As Long
Dim rowDepenses As Long
Dim plageTableau As Range
Dim tableau As ListObject
Dim chartRange As Range
Dim ChartObj As ChartObject
Dim cht As Chart

' Supprimer l'ancien rapport mensuel s'il existe

On Error Resume Next
[Link] = False
[Link]("RapportMensuel").Delete
[Link] = True
On Error GoTo 0

' Créer une nouvelle feuille pour le rapport mensuel

Set wsReport = [Link]
[Link] = "RapportMensuel"

' Initialisation des feuilles de travail

Set ws_members = [Link]("Membres")
Set ws_cotisations = [Link]("Cotisations")
 Set ws_depenses = [Link]("Depenses")

' Demander le mois et l'année

mois = CInt(InputBox("Entrez le numéro du mois (1-12):", "Rapport Mensuel"))
If mois < 1 Or mois > 12 Then Exit Sub

annee = CInt(InputBox("Entrez l'année:", "Rapport Mensuel"))

If annee < 2000 Then Exit Sub

' Titre du rapport

With wsReport
.[Link]
.Cells(1, 1) = "RAPPORT MENSUEL"
.Cells(2, 1) = "Mois: " & MonthName(mois) & " " & annee
.Range("A1:A2").[Link] = True

' Statistiques du mois

.Cells(4, 1) = "STATISTIQUES"
.Cells(4, 1).[Link] = True

' Nombre de membres actifs

nbMembres = ws_members.Cells(ws_members.[Link], 1).End(xlUp).row - 1
.Cells(5, 1) = "Total membres:"
.Cells(5, 2) = nbMembres

' Nombre de cotisations du mois

nbCotisations = 0
lastRow = ws_cotisations.Cells(ws_cotisations.[Link], 1).End(xlUp).row

For i = 2 To lastRow
If Month(ws_cotisations.Cells(i, 1)) = mois And Year(ws_cotisations.Cells(i, 1)) =
annee Then
nbCotisations = nbCotisations + 1
End If
Next i

.Cells(6, 1) = "Cotisations du mois:"

.Cells(6, 2) = nbCotisations

' Section des contributeurs

.Cells(12, 1) = "LISTE"
.Range("A13:D13").[Link] = True
.Cells(13, 1) = "ID"
.Cells(13, 2) = "Nom"
.Cells(13, 3) = "Prénom"
.Cells(13, 4) = "Montant total versé"

' Utiliser un dictionnaire pour les contributions

Set dictCont = CreateObject("[Link]")
lastCotRow = ws_cotisations.Cells(ws_cotisations.[Link], 1).End(xlUp).row

For i = 2 To lastCotRow
If Month(ws_cotisations.Cells(i, 1)) = mois And Year(ws_cotisations.Cells(i, 1)) =
annee Then
memberId = ws_cotisations.Cells(i, 2).Value
If [Link](memberId) Then
dictCont(memberId) = dictCont(memberId) + ws_cotisations.Cells(i,
5).Value
Else
[Link] memberId, ws_cotisations.Cells(i, 5).Value
End If
End If
Next i

' Écrire la liste des contributeurs

row = 14
For Each memberId In [Link]
.Cells(row, 1) = memberId

lastMemberRow = ws_members.Cells(ws_members.[Link],
1).End(xlUp).row
For j = 2 To lastMemberRow
If ws_members.Cells(j, 1).Value = memberId Then
.Cells(row, 2) = ws_members.Cells(j, 2).Value
.Cells(row, 3) = ws_members.Cells(j, 3).Value
Exit For
End If
Next j

.Cells(row, 4) = dictCont(memberId)
.Cells(row, 4).NumberFormat = "#,##0 CFA"
row = row + 1
Next memberId

' Total des contributions

.Cells(row, 1) = "TOTAL CONTRIBUTIONS"
.Range("A" & row & ":C" & row).Merge
.Cells(row, 4).Formula = "=SUM(D14:D" & (row - 1) & ")"
.Cells(row, 4).NumberFormat = "#,##0 CFA"
.Range("A" & row & ":D" & row).[Link] = True

' Section des dépenses du mois

.Cells(row + 2, 1) = "DÉPENSES DU MOIS"
row = row + 3
.Range("A" & row & ":C" & row).[Link] = True
.Cells(row, 1) = "Date"
.Cells(row, 2) = "Description"
.Cells(row, 3) = "Montant"

' Parcourir toutes les dépenses du mois

lastDepRow = ws_depenses.Cells(ws_depenses.[Link], 1).End(xlUp).row
startDepRow = row + 1
Dim totalDepensesMois As Double
totalDepensesMois = 0

For i = 2 To lastDepRow
If Month(ws_depenses.Cells(i, 1)) = mois And Year(ws_depenses.Cells(i, 1)) =
annee Then
.Cells(row, 1) = ws_depenses.Cells(i, 1).Value
.Cells(row, 2) = ws_depenses.Cells(i, 2).Value
.Cells(row, 3) = ws_depenses.Cells(i, 3).Value
.Cells(row, 3).NumberFormat = "#,##0 CFA"
totalDepensesMois = totalDepensesMois + ws_depenses.Cells(i, 3).Value
row = row + 1
 End If
Next i

' Total des dépenses

.Cells(row, 1) = "TOTAL DÉPENSES"
.Range("A" & row & ":B" & row).Merge
.Cells(row, 3) = totalDepensesMois
.Cells(row, 3).NumberFormat = "#,##0 CFA"
.Range("A" & row & ":C" & row).[Link] = True

' Calculer le solde historique

soldePrecedent = 0

' Cotisations précédentes

For i = 2 To lastCotRow
If ws_cotisations.Cells(i, 1).Value < DateSerial(annee, mois, 1) Then
soldePrecedent = soldePrecedent + ws_cotisations.Cells(i, 5).Value
End If
Next i

' Dépenses précédentes

For i = 2 To lastDepRow
If ws_depenses.Cells(i, 1).Value < DateSerial(annee, mois, 1) Then
soldePrecedent = soldePrecedent - ws_depenses.Cells(i, 3).Value
End If
Next i

' Bilan final avec solde précédent

row = row + 2
.Cells(row, 1) = "BILAN DU MOIS"
.Cells(row, 1).[Link] = True
row = row + 1

' Chercher les totaux

For i = 1 To row
If .Cells(i, 1).Value = "TOTAL CONTRIBUTIONS" Then
Set totalContributions = .Cells(i, 4)
ElseIf .Cells(i, 1).Value = "TOTAL DÉPENSES" Then
Set totalDepenses = .Cells(i, 3)
End If
Next i

' Écrire le bilan détaillé

.Cells(row, 1) = "Solde précédent"
.Cells(row, 2) = soldePrecedent
.Cells(row, 2).NumberFormat = "#,##0 CFA"
rowSoldePrecedent = row

row = row + 1
.Cells(row, 1) = "Total Contributions du mois"
.Cells(row, 2) = [Link]
.Cells(row, 2).NumberFormat = "#,##0 CFA"
rowContributions = row

row = row + 1
.Cells(row, 1) = "Total Dépenses du mois"
.Cells(row, 2) = [Link]
 .Cells(row, 2).NumberFormat = "#,##0 CFA"
rowDepenses = row

row = row + 1
.Cells(row, 1) = "Solde du mois"
.Cells(row, 2) = [Link] - [Link]
.Cells(row, 2).NumberFormat = "#,##0 CFA"

row = row + 1
.Cells(row, 1) = "SOLDE CUMULÉ"
.Cells(row, 2) = soldePrecedent + [Link] - [Link]
.Cells(row, 2).NumberFormat = "#,##0 CFA"
.Range("A" & row & ":B" & row).[Link] = True

' Ajouter une bordure double sous le solde cumulé

.Range("A" & row & ":B" & row).Borders(xlEdgeBottom).LineStyle = xlDouble

' Formatage supplémentaire

.Range("A" & rowSoldePrecedent & ":B" & row).Borders(xlEdgeLeft).LineStyle =
xlContinuous
.Range("A" & rowSoldePrecedent & ":B" & row).Borders(xlEdgeRight).LineStyle =
xlContinuous
.Range("A" & rowSoldePrecedent & ":B" & row).Borders(xlInsideHorizontal).LineStyle
= xlContinuous

' Mettre en évidence la section du bilan

.Range("A" & rowSoldePrecedent - 1 & ":B" & row).[Link] = 8 ' Gris clair

' Formatage final

.Range("A1:D" & row).HorizontalAlignment = xlCenter
.Range("A1:D" & row).VerticalAlignment = xlCenter

' Ajustement automatique de la largeur des colonnes

.Columns("A:D").AutoFit

' Mise en page pour impression

With .PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.CenterHorizontally = True
.CenterVertically = False
.LeftMargin = [Link](0.75)
.RightMargin = [Link](0.75)
.TopMargin = [Link](0.75)
.BottomMargin = [Link](0.75)
.HeaderMargin = [Link](0.3)
.FooterMargin = [Link](0.3)
End With

' En-tête et pied de page

.[Link] = "&B" & .Range("A1").Text
.[Link] = "&B" & .Range("A2").Text
.[Link] = "&D"
.[Link] = "Généré le: &D à &T"
.[Link] = "Page &P sur &N"
 ' Définir toutes les bordures et appliquer le style de tableau
Set plageTableau = .Range("A13:D" & row - 1)
Set tableau = .[Link](xlSrcRange, plageTableau, , xlYes)
[Link] = "TableStyleLight16"

' Centrer le texte dans le tableau

With plageTableau
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With

' Créer le graphique de tendance des transactions

' Supprimer les graphiques existants
For Each ChartObj In .ChartObjects
[Link]
Next ChartObj

' Définir la plage de données pour le graphique

Set chartRange = .Range("A13").CurrentRegion

' Créer le nouveau graphique

Set ChartObj = .[Link](Left:=.Range("H2").Left, Top:=.Range("H2").Top,
Width:=400, Height:=300)
Set cht = [Link]

With cht
.SetSourceData Source:=chartRange
.ChartType = xlColumnClustered
.HasTitle = True
.[Link] = "Tendance des transactions"
.Axes(xlValue).HasTitle = True
.Axes(xlValue).[Link] = "Montant (CFA)"
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).[Link] = "Membres"
End With

' Ajouter l'exportation en PDF

If MsgBox("Rapport mensuel généré avec succès!" & vbNewLine & "Voulez-vous
l'exporter en PDF ?", vbQuestion + vbYesNo) = vbYes Then
Call ExporterRapportMensuelPDF(wsReport)
End If
End With
End Sub

Sub ExporterRapportMensuelPDF(wsReport As Worksheet)

Dim cheminFichier As String
Dim nomFichier As String

' Vérification si wsReport est défini

If wsReport Is Nothing Then
MsgBox "Aucun rapport à exporter. Veuillez générer un rapport d'abord.",
vbExclamation
Exit Sub
End If

nomFichier = "Rapport_" & Format(Now, "yyyy-mm-dd_hhmmss") & ".pdf"

 With [Link](msoFileDialogFolderPicker)
.Title = "Sélectionner le dossier de sauvegarde"
.ButtonName = "Sélectionner"
If .Show = -1 Then ' -1 signifie OK
cheminFichier = .SelectedItems(1) & "\" & nomFichier
Else
Exit Sub ' Annuler si aucun dossier n'est sélectionné
End If
End With

' Optimiser l'export

With wsReport
Dim derniereLigne As Long
derniereLigne = .Cells(.[Link], "A").End(xlUp).row
.[Link] = "$A$1:$F$" & derniereLigne

' Ajustements de la mise en page

With .PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
.CenterHorizontally = True
.CenterVertically = False
.LeftMargin = [Link](0.75)
.RightMargin = [Link](0.75)
.TopMargin = [Link](0.75)
.BottomMargin = [Link](0.75)
.HeaderMargin = [Link](0.3)
.FooterMargin = [Link](0.3)
End With
End With

' Exporter en PDF avec gestion d'erreur

On Error GoTo PDFErrorHandler
[Link] _
Type:=xlTypePDF, _
fileName:=cheminFichier, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True

MsgBox "Le rapport a été exporté avec succès!" & vbNewLine & _
"Emplacement: " & cheminFichier, vbInformation
Exit Sub

PDFErrorHandler:
MsgBox "Une erreur s'est produite lors de l'export en PDF." & vbNewLine & _
"Erreur: " & [Link], vbCritical
End Sub
' Fonction pour appliquer un style de titre
Private Sub ApplyTitleStyle(rng As Range, bgColor As Long)
With rng
.[Link] = True
.[Link] = 14
 .[Link] = bgColor
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.[Link] = xlMedium
End With
End Sub

' Fonction pour appliquer un style d'en-tête

Private Sub ApplyHeaderStyle(rng As Range)
With rng
.[Link] = True
.[Link] = 11
.[Link] = RGB(242, 242, 242)
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.[Link] = xlThin
End With
End Sub

' Fonction pour appliquer un style de total

Private Sub ApplyTotalStyle(rng As Range)
With rng
.[Link] = True
.[Link] = RGB(217, 225, 242)
.HorizontalAlignment = xlRight
.[Link] = xlMedium
End With
End Sub
Sub GenererRapportAnnuel()
' Déclaration des feuilles de calcul
Dim wsReport As Worksheet
Dim ws_cotisations As Worksheet
Dim ws_depenses As Worksheet
Dim ws_members As Worksheet

' Initialisation des feuilles de calcul

On Error GoTo ErrorHandler
Set wsReport = [Link]("Rapport")
Set ws_cotisations = [Link]("Cotisations")
Set ws_depenses = [Link]("Depenses")
Set ws_members = [Link]("Membres")

' Effacer le contenu de la feuille avant de générer un nouveau rapport

[Link]

' Déclaration des variables

Dim annee As Integer
Dim i As Long
Dim row As Long
Dim membreID As String
Dim lastCotRow As Long, lastDepRow As Long, lastMemberRow As Long
Dim soldePrecedent As Double, totalContribPrecedentes As Double,
totalContribActuelles As Double, totalDepenses As Double

' Demander l'année

annee = CInt(InputBox("Entrez l'année:", "Rapport Annuel"))
If annee < 2000 Then Exit Sub
With wsReport
' Centrer tout le contenu de la feuille
.[Link] = xlCenter
.[Link] = xlCenter

' En-têtes du rapport avec style amélioré

.Range("A1:F1").Merge
.Range("A2:F2").Merge
ApplyTitleStyle .Range("A1:F1"), RGB(155, 194, 230)
.Range("A2").HorizontalAlignment = xlCenter

.Cells(1, 1).Value = "RAPPORT ANNUEL DÉTAILLÉ"

.Cells(2, 1).Value = "Année: " & annee
With .Range("A1:A2").Font
.Bold = True
End With

' Statistiques générales avec style

.Range("A4:F4").Merge
ApplyHeaderStyle .Range("A4:F4")
.Cells(4, 1).Value = "STATISTIQUES ANNUELLES"
.Cells(4, 1).[Link] = True

' Style pour le solde reporté

.Range("A5:B5").[Link] = RGB(0, 255, 255)

' Calcul du solde des années précédentes

soldePrecedent = 0
lastCotRow = ws_cotisations.Cells(ws_cotisations.[Link], 1).End(xlUp).row

For i = 2 To lastCotRow
If Year(ws_cotisations.Cells(i, 1)) < annee Then
soldePrecedent = soldePrecedent + ws_cotisations.Cells(i, 5).Value
End If
Next i

' Soustraire les dépenses des années précédentes

lastDepRow = ws_depenses.Cells(ws_depenses.[Link], 1).End(xlUp).row

For i = 2 To lastDepRow
If Year(ws_depenses.Cells(i, 1)) < annee Then
soldePrecedent = soldePrecedent - ws_depenses.Cells(i, 3).Value
End If
Next i

' Afficher le solde reporté

.Cells(5, 1).Value = "Solde de " & (annee - 1)
.Cells(5, 2).Value = soldePrecedent
.Cells(5, 2).NumberFormat = "#,##0 CFA"

' Section des membres

.Range("A7:F7").Merge
ApplyHeaderStyle .Range("A7:F7")
.Cells(7, 1).Value = "MEMBRES"
.Range("A7").[Link] = True
 ' En-têtes des contributions
ApplyHeaderStyle .Range("A8:F8")
.Cells(8, 1).Value = "ID Membre"
.Cells(8, 2).Value = "Nom"
.Cells(8, 3).Value = "Prénom"
.Cells(8, 4).Value = "Contributions 2024"
.Cells(8, 5).Value = "Contributions " & annee
.Cells(8, 6).Value = "Total cumulé"
With .Range("A8:F8").Font
.Bold = True
End With

' Dictionnaires pour stocker les contributions

Dim dictContribPrecedentes As Object
Dim dictContribActuelles As Object
Set dictContribPrecedentes = CreateObject("[Link]")
Set dictContribActuelles = CreateObject("[Link]")

' Parcourir les cotisations

For i = 2 To lastCotRow
membreID = ws_cotisations.Cells(i, 2).Value

If Year(ws_cotisations.Cells(i, 1)) < annee Then

If [Link](membreID) Then
dictContribPrecedentes(membreID) =
dictContribPrecedentes(membreID) + ws_cotisations.Cells(i, 5).Value
Else
[Link] membreID, ws_cotisations.Cells(i,
5).Value
End If
ElseIf Year(ws_cotisations.Cells(i, 1)) = annee Then
If [Link](membreID) Then
dictContribActuelles(membreID) = dictContribActuelles(membreID) +
ws_cotisations.Cells(i, 5).Value
Else
[Link] membreID, ws_cotisations.Cells(i, 5).Value
End If
End If
Next i

' Écrire les contributions

row = 9
totalContribPrecedentes = 0
totalContribActuelles = 0
lastMemberRow = ws_members.Cells(ws_members.[Link], 1).End(xlUp).row

For i = 2 To lastMemberRow
membreID = ws_members.Cells(i, 1).Value

.Cells(row, 1).Value = membreID

.Cells(row, 2).Value = ws_members.Cells(i, 2).Value
.Cells(row, 3).Value = ws_members.Cells(i, 3).Value

If [Link](membreID) Then
.Cells(row, 4).Value = dictContribPrecedentes(membreID)
totalContribPrecedentes = totalContribPrecedentes +
dictContribPrecedentes(membreID)
 Else
.Cells(row, 4).Value = 0
End If

If [Link](membreID) Then
.Cells(row, 5).Value = dictContribActuelles(membreID)
totalContribActuelles = totalContribActuelles +
dictContribActuelles(membreID)
Else
.Cells(row, 5).Value = 0
End If

.Cells(row, 6).Formula = "=SUM(D" & row & ":E" & row & ")"
row = row + 1
Next i

' Ligne des totaux

ApplyTotalStyle .Range("A" & row & ":F" & row)
.Cells(row, 1).Value = "TOTAL"
.Range("A" & row & ":C" & row).Merge
.Cells(row, 4).Value = totalContribPrecedentes
.Cells(row, 5).Value = totalContribActuelles
.Cells(row, 6).Formula = "=SUM(D" & row & ":E" & row & ")"
.Range("A" & row & ":F" & row).[Link] = True

' Format monétaire

.Range("D9:F" & row).NumberFormat = "#,##0 CFA"

' Section des dépenses

row = row + 3
.Range("A" & row & ":C" & row).Merge
ApplyHeaderStyle .Range("A" & row & ":C" & row)
.Cells(row, 1).Value = "DÉTAIL DES DÉPENSES"
.Cells(row, 1).[Link] = True

' En-têtes dépenses avec largeur de colonne ajustée

row = row + 1
.Cells(row, 1).Value = "Date"
.Cells(row, 2).Value = "Description"
.Cells(row, 3).Value = "Montant"
.Range("A" & row & ":C" & row).[Link] = True
ApplyHeaderStyle .Range("A" & row & ":C" & row)

' Ajuster la largeur de la colonne Description

.Columns("B").ColumnWidth = 50

' Liste des dépenses

totalDepenses = 0
row = row + 1
Dim startDepRow As Long
startDepRow = row

' Debug - Afficher le nombre de dépenses trouvées

[Link] "Nombre de lignes de dépenses: " & lastDepRow

' Lister toutes les dépenses (y compris celles des années précédentes)
For i = 2 To lastDepRow
 With ws_depenses
' Debug - Afficher les valeurs lues
[Link] "Ligne " & i & ": " & .Cells(i, 1).Value & " - " & .Cells(i, 2).Value & " - " &
.Cells(i, 3).Value

[Link](row, 1).Value = .Cells(i, 1).Value

[Link](row, 1).NumberFormat = "dd/mm/yyyy"

' S'assurer que la description est copiée correctement

[Link](row, 2).Value = Trim(.Cells(i, 2).Value)
[Link](row, 2).WrapText = True

[Link](row, 3).Value = .Cells(i, 3).Value

[Link](row, 3).NumberFormat = "#,##0 CFA"

' Ne pas inclure les dépenses des années précédentes dans le total de l'année
en cours
If Year(.Cells(i, 1).Value) = annee Then
totalDepenses = totalDepenses + .Cells(i, 3).Value
End If

row = row + 1
End With
Next i

' Si aucune dépense trouvée

If row = startDepRow Then
[Link](row, 1).Value = "-"
[Link](row, 2).Value = "Aucune dépense enregistrée"
[Link](row, 3).Value = 0
row = row + 1
End If

' Ajustement final des colonnes

.Columns("A:C").AutoFit
.Columns("B").ColumnWidth = [Link](.Columns("B").ColumnWidth, 50)

' Total des dépenses de l'année en cours

ApplyTotalStyle .Range("A" & row & ":C" & row)
.Cells(row, 1).Value = "TOTAL DÉPENSES " & annee
.Range("A" & row & ":B" & row).Merge
.Cells(row, 3).Value = totalDepenses
.Range("A" & row & ":C" & row).[Link] = True

' Appliquer une couleur de fond rouge vif sur la ligne "TOTAL DÉPENSES"
.Range("A" & row & ":C" & row).[Link] = RGB(255, 0, 0) ' Rouge vif
.Range("A" & row & ":C" & row).[Link] = RGB(0, 0, 0) ' Police en noir

' Centrer le contenu de la ligne "TOTAL DÉPENSES"

.Range("A" & row & ":C" & row).HorizontalAlignment = xlCenter
.Range("A" & row & ":C" & row).VerticalAlignment = xlCenter

' Bilan final

row = row + 3
.Range("A" & row & ":F" & row).Merge
ApplyTitleStyle .Range("A" & row & ":F" & row), RGB(155, 194, 230)
.Cells(row, 1).Value = "BILAN FINAL"
 .Range("A" & row & ":F" & row).[Link] = True

' Style pour les lignes du bilan

For i = row + 1 To row + 4
.Range("A" & i & ":B" & i).[Link] = RGB(242, 242, 242)
.Range("A" & i).HorizontalAlignment = xlRight
.Range("B" & i).NumberFormat = "#,##0 CFA"
Next i

' Détails du bilan

row = row + 1
.Cells(row, 1).Value = "Solde de " & (annee - 1)
.Cells(row, 2).Value = soldePrecedent

row = row + 1
.Cells(row, 1).Value = "Total Contributions " & annee
.Cells(row, 2).Value = totalContribActuelles

row = row + 1
.Cells(row, 1).Value = "Total Dépenses " & annee
.Cells(row, 2).Value = totalDepenses

row = row + 1
.Cells(row, 1).Value = "Solde Net " & annee
.Cells(row, 2).Value = totalContribActuelles - totalDepenses

' Solde cumulé

row = row + 2
.Cells(row, 1).Value = "SOLDE CUMULÉ AU 31/12/" & annee
.Cells(row, 2).Value = soldePrecedent + totalContribActuelles - totalDepenses
.Range("A" & row & ":B" & row).[Link] = True
.Range("A" & row & ":B" & row).[Link] = RGB(0, 255, 0)
.Range("A" & row & ":B" & row).[Link] = xlMedium

' Formatage final

With .Range("A1:F" & row)
.[Link] = "TimesNewRoman"
.[Link] = xlContinuous
.[Link] = 20
End With

' Alternance de couleurs

Dim rngData As Range
Set rngData = .Range("A9:F" & (row - 5))
For i = 1 To [Link] Step 2
[Link](i).[Link] = RGB(242, 242, 242)
Next i

' Ajustements finaux

.Columns("A:F").AutoFit
' Solution plus robuste :
With wsReport
.Activate
.[Link](1).FreezePanes = False
.Range("A9").Select
.[Link](1).FreezePanes = True
End With
 ' Proposition d'export PDF
If MsgBox("Rapport annuel détaillé généré avec succès!" & vbNewLine & _
"Voulez-vous l'exporter en PDF ?", _
vbQuestion + vbYesNo) = vbYes Then
Call ExporterRapportPDF
End If
End With
Exit Sub
ErrorHandler:
MsgBox "Une erreur s'est produite: " & [Link], vbCritical
End Sub
Sub ExporterRapportPDF()
Dim wsReport As Worksheet
Dim cheminFichier As String
Dim nomFichier As String

' Vérifier si la feuille de rapport existe

On Error Resume Next
Set wsReport = [Link]("Rapport")
On Error GoTo 0

If wsReport Is Nothing Then

MsgBox "La feuille de rapport n'existe pas. Veuillez générer un rapport d'abord.",
vbExclamation
Exit Sub
End If

' Créer le nom du fichier PDF avec la date et l'heure actuelles

nomFichier = "Rapport_Annuel_" & Format(Now, "yyyy-mm-dd_hhmmss") & ".pdf"

' Demander à l'utilisateur de sélectionner un dossier pour enregistrer le PDF

With [Link](msoFileDialogFolderPicker)
.Title = "Sélectionner un dossier pour enregistrer le rapport PDF"
.ButtonName = "Sélectionner"
If .Show = -1 Then ' Si l'utilisateur a sélectionné un dossier
cheminFichier = .SelectedItems(1) & "\" & nomFichier
Else
MsgBox "Aucun dossier sélectionné. L'exportation a été annulée.",
vbInformation
Exit Sub
End If
End With

' Configurer la zone d'impression pour inclure tout le rapport

With wsReport
Dim derniereLigne As Long
derniereLigne = .Cells(.[Link], "A").End(xlUp).row
.[Link] = "$A$1:$F$" & derniereLigne

' Ajuster la mise en page pour l'export PDF

With .PageSetup
.Orientation = xlLandscape ' Orientation paysage
.Zoom = False
.FitToPagesWide = 1 ' Ajuster à 1 page en largeur
.FitToPagesTall = False
.CenterHorizontally = True
.CenterVertically = False
 .LeftMargin = [Link](0.75)
.RightMargin = [Link](0.75)
.TopMargin = [Link](0.75)
.BottomMargin = [Link](0.75)
.HeaderMargin = [Link](0.3)
.FooterMargin = [Link](0.3)
End With

' Ajouter un en-tête et un pied de page

.[Link] = "&B" & .Range("A1").Text
.[Link] = "&B" & .Range("A2").Text
.[Link] = "&D"
.[Link] = "Généré le: &D à &T"
.[Link] = "Page &P sur &N"
End With

' Exporter en PDF avec gestion des erreurs

On Error GoTo PDFErrorHandler
[Link] _
Type:=xlTypePDF, _
fileName:=cheminFichier, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True ' Ouvrir le PDF après l'exportation

MsgBox "Le rapport a été exporté avec succès en PDF !" & vbNewLine & _
"Emplacement: " & cheminFichier, vbInformation
Exit Sub

PDFErrorHandler:
MsgBox "Une erreur s'est produite lors de l'export en PDF." & vbNewLine & _
"Erreur: " & [Link], vbCritical
End Sub
Sub GenererSuiviCotisationsManquees()
' Initialisation
Call InitializeWorksheets

' Créer/Réinitialiser la feuille de suivi

Dim wsManques As Worksheet
On Error Resume Next
[Link]("Suivi_Cotisations").Delete
Set wsManques = [Link]
[Link] = "Suivi_Cotisations"
On Error GoTo 0

With wsManques
' Titre principal
.Range("A1:G1").Merge
.Cells(1, 1) = "SUIVI DES COTISATIONS MANQUÉES"
.Cells(1, 1).[Link] = True
.Cells(1, 1).[Link] = 16
.Cells(1, 1).[Link] = RGB(255, 255, 255) ' Texte blanc
.Cells(1, 1).[Link] = RGB(0, 112, 192) ' Fond bleu
.Cells(1, 1).HorizontalAlignment = xlCenter
.Cells(1, 1).VerticalAlignment = xlCenter
 ' Sous-titre
.Range("A2:G2").Merge
.Cells(2, 1) = "Période: Décembre 2024 - " & MonthName(Month(Date)) & " " &
Year(Date)
.Cells(2, 1).[Link] = True
.Cells(2, 1).[Link] = 12
.Cells(2, 1).[Link] = RGB(0, 0, 0) ' Texte noir
.Cells(2, 1).[Link] = RGB(191, 191, 191) ' Fond gris clair
.Cells(2, 1).HorizontalAlignment = xlCenter
.Cells(2, 1).VerticalAlignment = xlCenter

' En-têtes des colonnes

.Cells(4, 1) = "ID"
.Cells(4, 2) = "Nom"
.Cells(4, 3) = "Prénom"
.Cells(4, 4) = "Total Mois"
.Cells(4, 5) = "Mois Manqués"
.Cells(4, 6) = "Montant Dû"
.Range("A4:F4").[Link] = True
.Range("A4:F4").[Link] = RGB(0, 176, 80) ' Fond vert
.Range("A4:F4").[Link] = RGB(255, 255, 255) ' Texte blanc
.Range("A4:F4").HorizontalAlignment = xlCenter
.Range("A4:F4").VerticalAlignment = xlCenter

' Bordures des en-têtes

.Range("A4:F4").Borders(xlEdgeBottom).LineStyle = xlContinuous
.Range("A4:F4").Borders(xlEdgeBottom).Weight = xlThick

' Parcourir tous les membres

Dim lastMemberRow As Long
Dim i As Long
lastMemberRow = ws_members.Cells([Link], 1).End(xlUp).row
Dim row As Long
row = 5

For i = 2 To lastMemberRow
Dim membreID As String
membreID = ws_members.Cells(i, 1).Value

' Calculer les mois manqués pour ce membre

Dim moisManques As String
Dim nombreMoisManques As Integer
moisManques = GetMoisManquesDepuisDec2024(membreID)
nombreMoisManques = CompterMoisManques(moisManques)

If nombreMoisManques > 0 Then

.Cells(row, 1) = membreID
.Cells(row, 2) = ws_members.Cells(i, 2).Value
.Cells(row, 3) = ws_members.Cells(i, 3).Value
.Cells(row, 4) = nombreMoisManques
.Cells(row, 5) = moisManques
.Cells(row, 6) = nombreMoisManques * 1000 ' Montant fixe par mois

' Centrer le contenu des cellules

.Range("A" & row & ":F" & row).HorizontalAlignment = xlCenter
.Range("A" & row & ":F" & row).VerticalAlignment = xlCenter
 ' Mise en forme conditionnelle pour les lignes
If row Mod 2 = 0 Then
.Range("A" & row & ":F" & row).[Link] = RGB(242, 242, 242) '
Fond gris clair alterné
Else
.Range("A" & row & ":F" & row).[Link] = RGB(255, 255, 255) '
Fond blanc
End If

row = row + 1
End If
Next i

' Bordures des données

.Range("A4:F" & row - 1).Borders(xlEdgeLeft).LineStyle = xlContinuous
.Range("A4:F" & row - 1).Borders(xlEdgeRight).LineStyle = xlContinuous
.Range("A4:F" & row - 1).Borders(xlEdgeBottom).LineStyle = xlContinuous
.Range("A4:F" & row - 1).Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Range("A4:F" & row - 1).Borders(xlInsideVertical).LineStyle = xlContinuous

' Total dû
.Cells(row, 5) = "TOTAL DÛ:"
.Cells(row, 6).Formula = "=SUM(F5:F" & (row - 1) & ")"
.Range("F5:F" & row).NumberFormat = "#,##0 CFA"
.Range("A" & row & ":F" & row).[Link] = True
.Range("A" & row & ":F" & row).[Link] = RGB(255, 192, 0) ' Fond orange
.Range("A" & row & ":F" & row).[Link] = RGB(0, 0, 0) ' Texte noir
.Range("A" & row & ":F" & row).HorizontalAlignment = xlCenter
.Range("A" & row & ":F" & row).VerticalAlignment = xlCenter

' Ajuster la largeur des colonnes

.Columns("A:F").AutoFit

' Ajouter un graphique pour visualiser les montants dus

Dim cht As ChartObject
Set cht = .[Link](Left:=.Range("H5").Left, Top:=.Range("H5").Top,
Width:=400, Height:=250)

With [Link]
' Configurer manuellement les données du graphique
.ChartType = xlColumnClustered
.HasTitle = True
.[Link] = "Montants Dûs par Membre"

' Ajouter une série de données

Dim serie As Series
Set serie = .[Link]
[Link] = "Montants Dûs"

' Définir les valeurs de l'axe X (noms des membres)

[Link] = [Link]("B5:B" & row - 1).Value ' Noms des membres
(axe X)

' Définir les valeurs de l'axe Y (montants dus)

[Link] = [Link]("F5:F" & row - 1).Value ' Montants dus (axe
Y)
 ' Configurer les axes
.Axes(xlValue).HasTitle = True
.Axes(xlValue).[Link] = "Montant (CFA)"
.Axes(xlCategory).HasTitle = True
.Axes(xlCategory).[Link] = "Membres"

' Couleur des colonnes

[Link] = RGB(0, 176, 80) ' Vert
End With
End With

MsgBox "Suivi des cotisations manquées généré avec succès!", vbInformation

End Sub
Function CompterMoisManques(moisManques As String) As Integer
' Si la chaîne est vide, retourner 0
If Trim(moisManques) = "" Then
CompterMoisManques = 0
Exit Function
End If

' Compter le nombre de virgules et ajouter 1 pour avoir le nombre total de mois
Dim nbVirgules As Integer
Dim i As Integer

For i = 1 To Len(moisManques)
If Mid(moisManques, i, 1) = "," Then
nbVirgules = nbVirgules + 1
End If
Next i

' Le nombre de mois est égal au nombre de virgules + 1

CompterMoisManques = nbVirgules + 1
End Function
Function GetMoisManquesDepuisDec2024(membreID As String) As String
Dim moisManques() As String
ReDim moisManques(0) ' Initialisation du tableau
Dim nbMois As Integer
Dim moisCourant As Date

' Débuter en décembre 2024

moisCourant = DateSerial(2024, 12, 1)
nbMois = 0

' Parcourir jusqu'au mois actuel

Do While moisCourant <= Date
' Vérifier si le membre a cotisé ce mois
If Not ACotisePourMois(membreID, Month(moisCourant), Year(moisCourant)) Then
' Ajouter le mois manqué au tableau
ReDim Preserve moisManques(nbMois)
moisManques(nbMois) = MonthName(Month(moisCourant), True) & " " &
Year(moisCourant)
nbMois = nbMois + 1
End If
' Passer au mois suivant
moisCourant = DateAdd("m", 1, moisCourant)
Loop
 ' Retourner les mois manqués sous forme de chaîne séparée par des virgules
If nbMois > 0 Then
GetMoisManquesDepuisDec2024 = Join(moisManques, ", ")
Else
GetMoisManquesDepuisDec2024 = ""
End If
End Function
Function ACotisePourMois(membreID As String, mois As Integer, annee As Integer) As
Boolean
Dim lastRow As Long
lastRow = ws_cotisations.Cells([Link], 1).End(xlUp).row

Dim i As Long
For i = 2 To lastRow
If ws_cotisations.Cells(i, 2).Value = membreID And _
Month(ws_cotisations.Cells(i, 1)) = mois And _
Year(ws_cotisations.Cells(i, 1)) = annee Then
ACotisePourMois = True
Exit Function
End If
Next i

ACotisePourMois = False
End Function

Function NbMoisManques(moisManques As String) As Integer

If moisManques = "" Then
NbMoisManques = 0
Else
NbMoisManques = UBound(Split(moisManques, ",")) + 1
End If
End Function
Sub GenererTableauBord()
Dim wsDashboard As Worksheet

' Vérifier si le tableau de bord existe déjà, sinon le créer

On Error Resume Next
Set wsDashboard = [Link]("Tableau_de_Bord")
On Error GoTo 0

If wsDashboard Is Nothing Then

' Créer une nouvelle feuille pour le tableau de bord
Set wsDashboard = [Link](Before:=[Link](1))
[Link] = "Tableau_de_Bord"
Else
' Effacer complètement le contenu existant
[Link]

End If

With wsDashboard
' Titre
.Cells(1, 1) = "TABLEAU DE BORD"
.Range("A1").[Link] = 14
.Range("A1").[Link] = True

' Section 1: Statistiques Générales

 .Cells(3, 1) = "STATISTIQUES GÉNÉRALES"
.Range("A3").[Link] = True

' Nombre total de membres

Dim nbMembres As Long
nbMembres = ws_members.Cells([Link], 1).End(xlUp).row - 1
.Cells(4, 1) = "Nombre total de membres:"
.Cells(4, 2) = nbMembres

' Nouveaux membres ce mois

Dim nbNouveauxMembres As Long
nbNouveauxMembres = 0
Dim lastMemberRow As Long
lastMemberRow = ws_members.Cells([Link], 1).End(xlUp).row

Dim i As Long
For i = 2 To lastMemberRow
If Month(ws_members.Cells(i, 6)) = Month(Date) And _
Year(ws_members.Cells(i, 6)) = Year(Date) Then
nbNouveauxMembres = nbNouveauxMembres + 1
End If
Next i

.Cells(5, 1) = "Nouveaux membres ce mois:"

.Cells(5, 2) = nbNouveauxMembres

' Section 2: Statistiques Financières

.Cells(7, 1) = "STATISTIQUES FINANCIÈRES"
.Range("A7").[Link] = True

' Calculer les totaux pour le mois en cours

Dim totalCotisationsMois As Double
Dim totalDepensesMois As Double
Dim lastCotRow As Long
Dim lastDepRow As Long

lastCotRow = ws_cotisations.Cells([Link], 1).End(xlUp).row

lastDepRow = ws_depenses.Cells([Link], 1).End(xlUp).row

' Cotisations du mois

For i = 2 To lastCotRow
If Month(ws_cotisations.Cells(i, 1)) = Month(Date) And _
Year(ws_cotisations.Cells(i, 1)) = Year(Date) Then
totalCotisationsMois = totalCotisationsMois + ws_cotisations.Cells(i,
5).Value
End If
Next i

' Dépenses du mois

For i = 2 To lastDepRow
If Month(ws_depenses.Cells(i, 1)) = Month(Date) And _
Year(ws_depenses.Cells(i, 1)) = Year(Date) Then
totalDepensesMois = totalDepensesMois + ws_depenses.Cells(i, 3).Value
End If
Next i

.Cells(8, 1) = "Total cotisations du mois:"

 .Cells(8, 2) = totalCotisationsMois
.Cells(9, 1) = "Total dépenses du mois:"
.Cells(9, 2) = totalDepensesMois
.Cells(10, 1) = "Solde du mois:"
.Cells(10, 2) = totalCotisationsMois - totalDepensesMois

' Formatage des nombres

.Range("B8:B10").NumberFormat = "#,##0 CFA"

' Graphique des cotisations vs dépenses

Dim cht As ChartObject
Set cht = .[Link](Left:=300, Top:=50, Width:=400, Height:=250)

With [Link]
.ChartType = xlColumnClustered
.SetSourceData Source:=[Link]("A8:B9")
.HasTitle = True
.[Link] = "Cotisations vs Dépenses du Mois"
.HasLegend = True
End With

' Formatage final

.Columns("A:B").AutoFit
.Range("A1:B10").[Link] = xlContinuous
End With

MsgBox "Tableau de bord mis à jour avec succès!", vbInformation

End Sub
Sub Main()
' Initialisation des feuilles de travail
Call InitializeWorksheets

' Menu principal

Dim choix As Integer

Do

choix = CInt(InputBox("Choisissez une option:" & vbCrLf & _

"1. Tableau de bord" & vbCrLf & _
"2. Ajouter un membre" & vbCrLf & _
"3. Enregistrer une cotisation" & vbCrLf & _
"4. Enregistrer une dépense" & vbCrLf & _
"5. Générer un rapport mensuel" & vbCrLf & _
"6. Générer un rapport annuel" & vbCrLf & _
"7. Liste des membres non contribuants" & vbCrLf & _
"8. Rechercher un membre" & vbCrLf & _
"9. Analyses statistiques" & vbCrLf & _
"10. Générer les rappels" & vbCrLf & _
"11. Mois Manques" & vbCrLf & _
"12. Quitter", "Menu Principal"))

Select Case choix

Case 1
Call GenererTableauBord
Case 2
Call AjouterMembre
 Case 3
Call EnregistrerCotisation
Case 4
Call EnregistrerDepense
Case 5
Call GenererRapportMensuel
Case 6
Call GenererRapportAnnuel
Case 7
Call ListeMembresNonContribuants
Case 8
Call RechercherMembre
Case 9
Call AnalyseFinanciere
Case 10
Call CreerRappelCotisation
Case 11
Call GenererSuiviCotisationsManquees
Case 12
Exit Do
End Select
Loop While True
End Sub