Projet d’automatisation de rapports avec Excel & VBA & Oracle

Réalisation:Haral Valcourt

Objectif

L'objectif de ce projet est de mettre en place une solution automatisée de reporting permettant de générer, mettre en forme et présenter dynamiquement des rapports et tableaux de bord basés sur des données issues d’une base de données Oracle 19C. L’objectif principal est de démontrer une maîtrise avancée du langage VBA, ainsi qu’une capacité à automatiser un processus de reporting de bout en bout.

Technologies et langages utilisés

• Microsoft Excel.
• VBA (Visual Basic for Applications) pour l’automatisation.
• SQL pour la récupération de données Oracle.
• SQL Developer pour tester certaines requêtes SQL
• Oracle Database (via OraOLEDB.Oracle).
• ADO pour la gestion des connexions et des recordsets.

Fonctionnalités

• Connexion directe à la base Oracle via ADO
• Exécution dynamique de requêtes SQL avec paramètres, regroupements et pivot SQL.
• Création automatique de graphiques
• Personnalisation graphique poussée
• Structuration des dashboards modulaires, avec séparation entre graphiques simples et graphiques avancés
• Interface visuelle entièrement générée par VBA
• Génération de rapports automatisés
• Mise en place de filtre au niveau des rapports
• Conception UI/UX dans Excel
• Export automatique des rapports en PDF
• Envoi automatique des rapports par e-mail
• Protection de l’interface

Résultats

• Diminution drastique du temps de production des rapports (de plusieurs heures à quelques secondes).
• Homogénéité des visuels.
• Démonstration concrète d’une maîtrise professionnelle du VBA, de l’intégration SQL-Oracle, et de la conception UI/UX dans Excel.

Etapes clés

• Connexion à la base de données
• Présentation du jeu de données
• Création des utilisateurs
• Création des tableaux de bord et des rapports
• Exportation des rapports au format pdf
• Diffusion des rapports par email
• Securisation du projet

Connexion à la base de données

Dans ce projet, l’accès aux données de la base Oracle est réalisé grâce à ADO (ActiveX Data Objects), une technologie Microsoft permettant d’interagir avec des bases de données relationnelles depuis VBA. Cette méthode permet de se connecter directement depuis un fichier Excel à une base Oracle distante, sans avoir à passer par un export manuel des données.

L’objet principal utilisé est ADODB.Connection, qui sert à ouvrir une session entre Excel et Oracle. Il est configuré avec une chaîne de connexion (Connection String) qui contient les paramètres essentiels : le nom du fournisseur (Provider), l’adresse du serveur, le SID ou le nom de service, ainsi que les identifiants d’accès (utilisateur et mot de passe).

Script VBA de connexion à la base de données

 ```vba
Public Function GetConnexionOracle() As ADODB.Connection
    
Dim wb As Workbook
Dim CONN_STRING, PasswordStocke As String
Set wb = ThisWorkbook
PasswordStocke = wb.Sheets("FeuilParam").Range("A4").Value
CONN_STRING = "Provider=OraOLEDB.Oracle;Data Source=ORCLPDB;User ID=system;Password=" & PasswordStocke & ";"
     
    On Error GoTo ErreurConnexion
    
    ' Vérifier si la connexion existe déjà et est active
    If Not connOracle Is Nothing Then
        If connOracle.State = adStateOpen Then
            Set GetConnexionOracle = connOracle
            Exit Function
        End If
    End If
    
    ' Créer une nouvelle connexion
    Set connOracle = New ADODB.Connection
    connOracle.ConnectionString = CONN_STRING
    connOracle.Open
    
    Set GetConnexionOracle = connOracle
    Exit Function
    
ErreurConnexion:
    MsgBox "Erreur de connexion Oracle : " & Err.Description, vbCritical
    Set GetConnexionOracle = Nothing
    If Not connOracle Is Nothing Then
        Set connOracle = Nothing
    End If
End Function

``` 

Présentation du jeu de données

Script VBA de récupération de la structure de la table Compte

 ```vba

Sub ListerColonnes()
    Dim conn As Object
    Dim rs As Object
    Dim ws As Worksheet
    Dim i As Long
    
     ' Connexion Oracle
    Set conn = GetConnexionOracle()
    
    If conn Is Nothing Then
        MsgBox "Impossible d'établir la connexion à Oracle.", vbCritical
        Exit Sub
    End If
    Set rs = CreateObject("ADODB.Recordset")
  
    ' Requête SQL
    Dim sql As String
    sql = "SELECT COLUMN_NAME, DATA_TYPE, DATA_LENGTH FROM ALL_TAB_COLUMNS WHERE TABLE_NAME = 'COMPTE' AND OWNER = 'SYSTEM' ORDER BY COLUMN_ID"
    rs.Open sql, conn, 1, 1
    

    ' Préparation de la feuille Excel
    Set ws = ThisWorkbook.Sheets.Add
    ws.Name = "StructureCompte"
    ws.Cells.ClearContents

    ' En-têtes
    ws.Cells(1, 1).Value = "Nom de Colonne"
    ws.Cells(1, 2).Value = "Type de Donnée"
    ws.Cells(1, 3).Value = "Taille"

    ' Remplissage
    i = 2
    Do While Not rs.EOF
        ws.Cells(i, 1).Value = rs.Fields("COLUMN_NAME").Value
        ws.Cells(i, 2).Value = rs.Fields("DATA_TYPE").Value
        ws.Cells(i, 3).Value = rs.Fields("DATA_LENGTH").Value
        i = i + 1
        rs.MoveNext
    Loop

    ' Mise en forme simple
    ws.Columns("A:C").AutoFit

With Range("A1:C1")
     .Interior.Color = RGB(142, 154, 175)
End With

    ' Nettoyage
    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing

    MsgBox "Structure de la table COMPTE importée avec succès.", vbInformation
End Sub
 ``` 

Création des utilisateurs

Résumé du processus de création des utilisateurs

Le processus de création d'un utilisateur de l'application est le suivant:

• Inscription dans la table applicative (utilisateur)
• Création de l’utilisateur Oracle
• Attribution des privilèges Oracle
• Encodage et stockage du mot de passe

Interface de création des utilisateurs

Script VBA de création des utilisateurs

 ```vba

Private Sub btnAjouterUtilisateur_Click()
       
    Call ConnexionOraclePDB
        
    If conn Is Nothing Then
        MsgBox "Connexion échouée à la base de données.", vbCritical
        Exit Sub
    End If

    Dim nomUtilisateur As String
    Dim motDePasse As String
    Dim motDePasseChiffre As String
    Dim profil As String
    nomUtilisateur = Trim(Me.txtNomUtilisateur.Text)
    motDePasse = Trim(Me.txtMotDePasse.Text)
    profil = Me.cmbProfil.Value

    If nomUtilisateur = "" Or motDePasse = "" Or profil = "" Then
        MsgBox "Veuillez remplir tous les champs.", vbExclamation
        Exit Sub
    End If

    ' Chiffrement simple (base64)
    motDePasseChiffre = EncodeBase64(motDePasse)

    ' Insertion dans la table utilisateur
    Dim cmd As ADODB.Command
    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = conn
        .CommandText = "INSERT INTO utilisateur (id_utilisateur, nom_utilisateur, mot_de_passe, profil) " & _
                       "VALUES (seq_utilisateur.NEXTVAL, :nom, :pwd, :profil)"
        .CommandType = adCmdText
        .Parameters.Append .CreateParameter(":nom", adVarChar, adParamInput, 50, nomUtilisateur)
        .Parameters.Append .CreateParameter(":pwd", adVarChar, adParamInput, 50, motDePasseChiffre)
        .Parameters.Append .CreateParameter(":profil", adVarChar, adParamInput, 20, profil)
        .Execute
    End With

    ' Création de l'utilisateur Oracle
    Dim sqlCreateUser As String
    sqlCreateUser = "CREATE USER " & nomUtilisateur & " IDENTIFIED BY " & motDePasse
    conn.Execute sqlCreateUser

    ' Attribution de privileges
    conn.Execute "GRANT CONNECT TO " & nomUtilisateur
    conn.Execute "GRANT CREATE SESSION TO " & nomUtilisateur

    MsgBox "Utilisateur ajouté avec succès.", vbInformation
    Unload Me
End Sub
 ``` 

Vérification de la création de l'utilisateur à travers Oracle SQL Developer

Connexion de l'utilisateur

Script VBA de connexion des utilisateurs

 ```vba

Private Sub btnConnexion_Click()
    Dim cmd As ADODB.Command
    Dim rs As ADODB.Recordset
    Dim login As String, mdp As String, profil As String
    Dim sql As String

    ' Récupérer les identifiants depuis les champs du formulaire
    login = Trim(Me.txtUser.Text)
    mdp = Trim(Me.txtPass.Text)
    mdp = EncodeBase64(mdp)
    
    ' Appel à la procédure de connexion dans Module1
    ConnexionOraclePDB
    
    If conn Is Nothing Or conn.State <> adStateOpen Then
        MsgBox "Connexion échouée. Vérifiez vos paramètres.", vbCritical
        Exit Sub
    End If

    ' Requête sécurisée
    sql = "SELECT PROFIL FROM UTILISATEUR WHERE NOM_UTILISATEUR = ? AND MOT_DE_PASSE = ?"

    Set cmd = New ADODB.Command
    With cmd
        .ActiveConnection = conn
        .CommandText = sql
        .CommandType = adCmdText
        .Parameters.Append .CreateParameter("login", adVarChar, adParamInput, 50, login)
        .Parameters.Append .CreateParameter("mdp", adVarChar, adParamInput, 50, mdp)
    End With

    Set rs = cmd.Execute

    If Not rs.EOF Then
        profil = LCase(Trim(rs.Fields("PROFIL").Value))
        MsgBox "Bienvenue " & login & " (" & profil & ")", vbInformation
        
        AfficherFeuillesSelonProfil profil
        Me.Hide
    Else
        MsgBox "Login ou mot de passe incorrect.", vbExclamation
    End If

    ' Nettoyage
    If Not rs Is Nothing Then rs.Close
    If Not conn Is Nothing Then conn.Close

    Set rs = Nothing
    Set cmd = Nothing
    Set conn = Nothing
End Sub
 ``` 

Présentation de l'application

L'application est composée des pages suivantes:

• La page d'accueil
• La page d'administration
• La page DashboardSimple
• La page DashboardAvance
• Les pages de certains rapports
• Les rapports générés sauvegardés.

La page d'accueil

Elle est constituée principlament du formulaire de connexion à l'application en fonction du profil de l'utilisateur

La page d'administration

Cette page, accessible uniquement à l'administrateur, permet la réalisation des tâches suivantes

• Création ou rafraîchissement automatique du Dashboard avec visuels simples
• Création ou rafraîchissement automatique du Dashboard avec visuels avancés
• Activation de la protection des rapports et des dashboards
• Désactivation de la protection des rapports et des dashboards
• Création des utilisateurs de l'application

La page DashboardSimple

Accessible aux utilisateurs de profil "Opérateur", elle est constituée

• D'un bloc de KPIs: Solde total, Nombre de comptes, % Compte Courant, % Compte épargne, % Dépôt à terme, % Prêt à terme
• D'un bloc de visuels simples
  • Répartition des comptes par statut
  • Répartition du montant total par type
  • Répartition des comptes par succursale
  • Répartition des comptes par sexe
  • Pourcentage du montant total par zone
  • Répartition des comptes par tranche d'âge
• D'une zone réservée aux rapports regroupés par:
  • Activité mensuelle
  • Segmentation client
  • Répartition géographique
  • Typologie des comptes

La page DashboardAvance

Accessible aux utilisateurs de profil "Manager", elle est constituée

• D'un bloc de visuels avancés
  • Répartition du solde et des comptes par zone
  • Répartition du montant moyen par zone et sexe
  • Montant et nombre de comptes par succursale
  • Nombre de comptes actifs par statut et tranche d'âge
  • Evolution du solde par année et type de compte
  • Top 5 grands clients par type de compte
• D'une zone réservée
  • A d'autres rapports
  • A l'exportation en PDF
  • A la transmission par email

Rapports crées dans le workbook

Analyse des performances par succursale et produit

Analyse des succursale avec filtre

Rapport d'analyse filtré pour une succursale

Les rapports générés sauvegardés hors du workbook

Comptes ouverts par trimestre

Scripte VBA du rapport des comptes ouverts par trimestre

 ```vba

Sub Rapport_OuvertsParTrimestre()
    Dim conn As Object, rs As Object
    Dim wbTemp As Workbook, ws As Worksheet
    Dim chartObj1 As ChartObject, chartObj2 As ChartObject
    Dim i As Long, lastRow As Long
    Dim tblRange As Range
    Dim paletteColors As Variant
    Dim dossierBase As String, dossierRapport As String, nomFichier As String, cheminComplet As String
    
    ' Palette personnalisée (hexadécimale convertie en RGB)
    paletteColors = Array(HexToRGBColor("8e9aaf"), HexToRGBColor("cbc0d3"), HexToRGBColor("efd3d7"), _
                          HexToRGBColor("feeafa"), HexToRGBColor("dee2ff"), HexToRGBColor("b8bedd"))
   
    ' Connexion Oracle
    Set conn = GetConnexionOracle()
    If conn Is Nothing Then
        MsgBox "Impossible d'établir la connexion à Oracle.", vbCritical
        Exit Sub
    End If
    
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open "SELECT TO_CHAR(DATEOPEN, 'YYYY') || ' T' || TO_CHAR(DATEOPEN, 'Q') AS TRIMESTRE, COUNT(*) AS NOMBRE " & _
            "FROM compte GROUP BY TO_CHAR(DATEOPEN, 'YYYY'), TO_CHAR(DATEOPEN, 'Q') ORDER BY 1", conn
    
    ' Créer un nouveau classeur temporaire
    Set wbTemp = Workbooks.Add(xlWBATWorksheet) ' classeur avec 1 feuille
    
    ' Renommer la feuille active
    Set ws = wbTemp.Sheets(1)
    ws.Name = "Rapport Trimestriel"
    
    ' --- REMPLISSAGE DES DONNÉES ---
    ' Titre
    With ws.Range("A1:W1")
        .Merge
        .Value = "Rapport des Comptes Ouverts par Trimestre"
        .Font.Size = 16
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .Interior.Color = paletteColors(0)
    End With
    
    ' En-têtes
    ws.Range("A3").Value = "Trimestre"
    ws.Range("B3").Value = "Nombre"
    ws.Range("A3:B3").Font.Bold = True
    ws.Range("A3:B3").Interior.Color = paletteColors(1)
    
    ' Données
    i = 4
    Do While Not rs.EOF
        ws.Cells(i, 1).Value = rs.Fields(0).Value
        ws.Cells(i, 2).Value = rs.Fields(1).Value
        rs.MoveNext
        i = i + 1
    Loop
    lastRow = i - 1
    
    ' Format tableau et couleurs
    Set tblRange = ws.Range("A3:B" & lastRow)
    tblRange.Borders.LineStyle = xlContinuous
    For i = 4 To lastRow
        ws.Range("A" & i & ":B" & i).Interior.Color = paletteColors((i - 4) Mod UBound(paletteColors) + 1)
    Next i
    
    ' Graphique en barres verticales
    Set chartObj1 = ws.ChartObjects.Add(Left:=ws.Range("C3").Left, Width:=500, Top:=ws.Range("C3").Top, Height:=300)
    With chartObj1.Chart
        .SetSourceData Source:=tblRange
        .ChartType = xlColumnClustered
        .HasLegend = False
        .HasTitle = True
        .ChartTitle.Text = "Comptes Ouverts par Trimestre"
        .ChartTitle.Font.Size = 12
        .ChartTitle.Font.Bold = True

        .Axes(xlCategory).HasTitle = False
        .Axes(xlValue).HasTitle = False
        On Error Resume Next
        .Axes(xlCategory).MajorGridlines.Delete
        .Axes(xlValue).MajorGridlines.Delete
        On Error GoTo 0
        .Axes(xlCategory).TickLabels.Orientation = xlUpward
        On Error Resume Next
        .Axes(xlValue).Delete
        On Error GoTo 0
        ' Couleurs personnalisées
        For i = 1 To .SeriesCollection(1).Points.Count
            .SeriesCollection(1).Points(i).Format.Fill.ForeColor.RGB = paletteColors((i - 1) Mod UBound(paletteColors) + 1)
        Next i
        .SeriesCollection(1).ApplyDataLabels
    End With
    
    ' Graphique en courbe
    Set chartObj2 = ws.ChartObjects.Add(Left:=chartObj1.Left + chartObj1.Width + 5, Width:=500, Top:=chartObj1.Top, Height:=300)
    With chartObj2.Chart
        .SetSourceData Source:=tblRange
        .ChartType = xlLine
        .HasTitle = True
        .ChartTitle.Text = "Comptes Ouverts par Trimestre"
        .ChartTitle.Font.Size = 12
        .ChartTitle.Font.Bold = True
        .HasLegend = False
        .Axes(xlCategory).HasTitle = False
        .Axes(xlCategory).TickLabels.Font.Size = 10
        On Error Resume Next
        .Axes(xlValue).Delete
        .Axes(xlCategory).MajorGridlines.Delete
        .Axes(xlValue).MajorGridlines.Delete
        On Error GoTo 0
        .Axes(xlCategory).TickLabels.Orientation = xlUpward
        With .SeriesCollection(1).Format.Line
            .ForeColor.RGB = paletteColors(3)
            .Weight = 3.5
        End With
        .SeriesCollection(1).ApplyDataLabels
    End With
    
    
    Call ProtegerToutesLesFeuillesDansClasseur(wbTemp, "tonMotDePasse")
    
    ' --- Sauvegarde dans dossier RapportExcel ---
    dossierBase = ThisWorkbook.Path
    If Right(dossierBase, 1) <> "\" Then dossierBase = dossierBase & "\"
    
    dossierRapport = dossierBase & "RapportExcel\"
    If Dir(dossierRapport, vbDirectory) = "" Then MkDir dossierRapport
    
    nomFichier = "Rapport_Trimestriel_" & Format(Date, "yyyymmdd") & ".xlsx"
    cheminComplet = dossierRapport & nomFichier
    
    ' Supprimer fichier existant si présent
    If Dir(cheminComplet) <> "" Then Kill cheminComplet
    
    ' Sauvegarder le classeur temporaire
    Application.DisplayAlerts = False
    wbTemp.SaveAs Filename:=cheminComplet, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    
    wbTemp.Close SaveChanges:=False
    
    ' Nettoyage
    If Not rs Is Nothing Then
        If rs.State = 1 Then rs.Close
        Set rs = Nothing
    End If
    If Not conn Is Nothing Then
        If conn.State = 1 Then conn.Close
        Set conn = Nothing
    End If
    
    MsgBox "Rapport trimestriel généré et sauvegardé dans " & cheminComplet, vbInformation
End Sub
 ``` 

Répartition du solde par année

Script VBA du rapport de répartition du solde par année

 ```vba
Sub RapportVolumeAnnuel()
    Dim conn As Object, rs As Object
    Dim wsTemp As Worksheet
    Dim sql As String
    Dim i As Integer
    Dim tblStartCell As Range
    Dim chartObj As ChartObject, chartObjPie As ChartObject
    Dim lastRow As Long
    Dim couleurs As Variant
    Dim wbTemp As Workbook
    Dim cheminTemp As String
    Dim dossierBase As String, dossierRapport As String, nomFichier As String, cheminComplet As String
    
    
     ' Connexion Oracle
    Set conn = GetConnexionOracle()
    If conn Is Nothing Then
        MsgBox "Impossible d'établir la connexion à Oracle.", vbCritical
        Exit Sub
    End If
    Set rs = CreateObject("ADODB.Recordset")
       
    ' Requête SQL : Volume annuel
    sql = "SELECT TO_CHAR(DATEOPEN, 'YYYY') AS ANNEE, TRUNC(SUM(BALANCE)/1000000, 2) AS VOLUME " & _
          "FROM compte WHERE DATEOPEN IS NOT NULL GROUP BY TO_CHAR(DATEOPEN, 'YYYY') ORDER BY 1"
    
    ' Exécuter la requête
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open sql, conn, 1, 1 ' adOpenKeyset, adLockReadOnly
    
    ' Créer un nouveau classeur temporaire
    Set wbTemp = Workbooks.Add(xlWBATWorksheet)
    Set wsTemp = wbTemp.Sheets(1)
    wsTemp.Name = "VolumeAnnuel"
    
    ' Point d’insertion du tableau
    Set tblStartCell = wsTemp.Range("E3")
    
    ' Entêtes
    For i = 1 To rs.Fields.Count
        tblStartCell.Cells(1, i).Value = rs.Fields(i - 1).Name
    Next i
    
    ' Données
    tblStartCell.Offset(1, 0).CopyFromRecordset rs
    
    ' AutoFit colonnes
    lastRow = wsTemp.Cells(wsTemp.Rows.Count, tblStartCell.Column).End(xlUp).Row
    wsTemp.Range(tblStartCell, wsTemp.Cells(lastRow, tblStartCell.Column + 1)).Columns.AutoFit
    
    ' Palette de couleurs personnalisée
    couleurs = Array("8e9aaf", "cbc0d3", "efd3d7", "feeafa", "dee2ff")
    
    ' Créer le graphique en barres
    Set chartObj = wsTemp.ChartObjects.Add( _
        Left:=wsTemp.Range("A1").Left, _
        Width:=455, _
        Top:=wsTemp.Cells(lastRow + 2, 1).Top, Height:=250)
    
    With chartObj.Chart
        .ChartType = xlColumnClustered
        .SetSourceData Source:=wsTemp.Range(tblStartCell, wsTemp.Cells(lastRow, tblStartCell.Column + 1))
        .HasTitle = True
        .ChartTitle.Text = "Volume annuel (en M)"
        .ChartTitle.Font.Size = 12
        .ChartTitle.Font.Bold = True
        
        ' Afficher les valeurs sur les barres
        .SeriesCollection(1).ApplyDataLabels
        
        ' Supprimer la grille principale
        On Error Resume Next
        .Axes(xlValue).MajorGridlines.Delete
        .Axes(xlValue).Delete ' supprime axe Y
        On Error GoTo 0
        
        ' Supprimer titre axe catégories et légende
        .Axes(xlCategory).HasTitle = False
        .Legend.Delete
        
        ' Appliquer les couleurs personnalisées
        Dim idx As Integer
        For i = 1 To .SeriesCollection(1).Points.Count
            idx = ((i - 1) Mod UBound(couleurs) + 1)
            With .SeriesCollection(1).Points(i).Format.Fill.ForeColor
                .RGB = RGB( _
                    CLng("&H" & mid(couleurs(idx - 1), 1, 2)), _
                    CLng("&H" & mid(couleurs(idx - 1), 3, 2)), _
                    CLng("&H" & mid(couleurs(idx - 1), 5, 2)) _
                )
            End With
        Next i
    End With
    
    ' Créer le graphique en secteurs
    Set chartObjPie = wsTemp.ChartObjects.Add( _
        Left:=chartObj.Left, _
        Width:=chartObj.Width, _
        Top:=chartObj.Top + chartObj.Height + 10, _
        Height:=chartObj.Height)
    
    With chartObjPie.Chart
        .ChartType = xlPie
        .SetSourceData Source:=wsTemp.Range(tblStartCell.Offset(1, 0), wsTemp.Cells(lastRow, tblStartCell.Column + 1))
        .HasTitle = True
        .ChartTitle.Text = "Répartition du volume par année"
        .ChartTitle.Font.Size = 12
        .ChartTitle.Font.Bold = True
        .HasLegend = True
        
        ' Afficher valeurs et pourcentages
        .ApplyDataLabels
        Dim pt As Point
        For Each pt In .SeriesCollection(1).Points
            pt.DataLabel.ShowPercentage = True
            pt.DataLabel.ShowValue = False
        Next pt
        
        ' Appliquer couleurs personnalisées
        For i = 1 To .SeriesCollection(1).Points.Count
            .SeriesCollection(1).Points(i).Format.Fill.ForeColor.RGB = RGB( _
                CLng("&H" & mid(couleurs(i - 1), 1, 2)), _
                CLng("&H" & mid(couleurs(i - 1), 3, 2)), _
                CLng("&H" & mid(couleurs(i - 1), 5, 2)) _
            )
        Next i
    End With
    
    ' Formatage du tableau de données
    With wsTemp.Range("E3:F3")
        .Font.Name = "Calibri"
        .Font.Size = 11
        .Borders.LineStyle = xlContinuous
        .Interior.Color = RGB(225, 225, 240)
        .HorizontalAlignment = xlCenter
    End With
    
    With wsTemp.Range("E4:F" & lastRow)
        .Font.Name = "Calibri"
        .Font.Size = 11
        .Borders.LineStyle = xlContinuous
        .Interior.Color = RGB(242, 242, 242)
        .HorizontalAlignment = xlCenter
    End With
    
    ' Formatage du titre
    With wsTemp.Range("A1:J1")
        .Merge
        .Value = "Répartition du solde par année"
        .Font.Bold = True
        .Font.Size = 16
        .Font.Name = "Calibri"
        .Font.Color = RGB(0, 0, 0)
        .Interior.Color = RGB(225, 225, 240)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Borders.LineStyle = xlNone
        .RowHeight = 20
    End With
    
    With wsTemp
        .Rows("2:8").RowHeight = 12
    End With
    
    'Protéger les feuilles du classeur principal
    Call ProtegerToutesLesFeuillesDansClasseur(wbTemp, "tonMotDePasse")
    
  ' --- Sauvegarde dans dossier RapportExcel ---
    dossierBase = ThisWorkbook.Path
    If Right(dossierBase, 1) <> "\" Then dossierBase = dossierBase & "\"
    
    dossierRapport = dossierBase & "RapportExcel\"
    If Dir(dossierRapport, vbDirectory) = "" Then MkDir dossierRapport
    
    nomFichier = "Rapport_VolumeAnnuel_" & Format(Date, "yyyymmdd") & ".xlsx"
    cheminComplet = dossierRapport & nomFichier
    
    ' Supprimer fichier existant si présent
    If Dir(cheminComplet) <> "" Then Kill cheminComplet
    
    ' Sauvegarder le classeur temporaire
    Application.DisplayAlerts = False
    wbTemp.SaveAs Filename:=cheminComplet, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    
    wbTemp.Close SaveChanges:=False
   
    ' Nettoyage objets
    rs.Close
    conn.Close
    Set rs = Nothing
    Set conn = Nothing
   
    
    MsgBox "Rapport généré avec succès", vbInformation
End Sub
 ``` 

Répartition des comptes et du solde moyen par statut

Script VBA du rapport de répartition des comptes et du solde moyen par statut

 ```vba
Sub RapportCompteStatut()
    Dim conn As Object, rs As Object
    Dim ws As Worksheet
    Dim chartObj, chartObj1, chartObj2 As ChartObject, s As Series
    Dim startRow As Long, startCol As Long, lastRow As Long
    Dim dataRange As Range, i As Long
    Dim req1 As String, req2 As String
    Dim rs1 As Object, rs2 As Object
    Dim couleurs As Variant
    
    Dim dossierBase As String
    Dim dossierRapport As String
    Dim nomFichier As String
    Dim cheminComplet As String

    Dim wbTemp As Workbook
   
   ' Nouveau classeur
    Set wbTemp = Workbooks.Add(xlWBATWorksheet)
    Set ws = wbTemp.Worksheets(1)
    ws.Name = "CompteStatut"
    
    With Worksheets("CompteStatut").PageSetup
    .Orientation = xlLandscape
    .LeftMargin = Application.InchesToPoints(0.5)
    .RightMargin = Application.InchesToPoints(0.5)
    .TopMargin = Application.InchesToPoints(0.75)
    .BottomMargin = Application.InchesToPoints(0.75)
    .HeaderMargin = Application.InchesToPoints(0.3)
    .FooterMargin = Application.InchesToPoints(0.3)
    End With
      
      ' Connexion Oracle
    Set conn = GetConnexionOracle()
    If conn Is Nothing Then
        MsgBox "Impossible d'établir la connexion à Oracle.", vbCritical
        Exit Sub
    End If

    'Requête 1 - STATUT ET SOLDE MOYEN
    req1 = "SELECT STATUT_COMPTE, ROUND(AVG(BALANCE), 2) AS SOLDE_MOYEN FROM COMPTE GROUP BY STATUT_COMPTE ORDER BY SOLDE_MOYEN DESC"
    Set rs1 = CreateObject("ADODB.Recordset")
    rs1.Open req1, conn, 3, 1
    
    ' Requête 2 - STATUT_COMPTE ET NOMBRE DE COMPTE
    req2 = "SELECT STATUT_COMPTE, COUNT(NOCOMPTE) AS NOMBRE_COMPTE FROM COMPTE GROUP BY STATUT_COMPTE ORDER BY NOMBRE_COMPTE DESC"
    Set rs2 = CreateObject("ADODB.Recordset")
    rs2.Open req2, conn, 3, 1

    
    ' Création du graphique 1
    startRow = 3
    startCol = 3
    For i = 0 To rs1.Fields.Count - 1
        ws.Cells(startRow, startCol + i).Value = rs1.Fields(i).Name
    Next i
    ws.Cells(startRow + 1, startCol).CopyFromRecordset rs1

    lastRow = ws.Cells(ws.Rows.Count, startCol).End(xlUp).Row
    Set dataRange = ws.Range(ws.Cells(startRow, startCol), ws.Cells(lastRow, startCol + 1))

   ' Créer le graphique
Set chartObj1 = ws.ChartObjects.Add(Left:=5, Top:=110, Width:=300, Height:=300)
With chartObj1.Chart
    .ChartType = xlColumnClustered
    .SetSourceData dataRange
    .HasTitle = True
    .ChartTitle.Text = "Solde moyen par statut"
    .HasLegend = False
    .ChartGroups(1).GapWidth = 30
End With

With chartObj1.Chart
    .HasTitle = True
    .ChartTitle.Font.Size = 12
    .ChartTitle.Font.Bold = True
    .ChartTitle.Font.Color = RGB(0, 0, 128)
End With


chartObj1.Chart.Axes(xlValue).Delete
chartObj1.Chart.Axes(xlValue).MajorGridlines.Format.Line.Visible = msoFalse
chartObj1.Chart.Axes(xlCategory).MajorGridlines.Delete '

' Ajouter les labels
With chartObj1.Chart.SeriesCollection(1)
    .ApplyDataLabels
    With .DataLabels
        .ShowValue = True
        .Position = xlLabelPositionInsideEnd
    End With
End With

    Set s = chartObj1.Chart.SeriesCollection(1)
    For i = 1 To s.Points.Count
        Select Case LCase(Trim(s.XValues(i)))
            Case "ouvert":  s.Points(i).Format.Fill.ForeColor.RGB = RGB(142, 154, 175)
            Case "dormant": s.Points(i).Format.Fill.ForeColor.RGB = RGB(203, 192, 211)
            Case "no débit": s.Points(i).Format.Fill.ForeColor.RGB = RGB(239, 211, 215)
            Case "fermé":   s.Points(i).Format.Fill.ForeColor.RGB = RGB(254, 234, 250)
            Case Else:      s.Points(i).Format.Fill.ForeColor.RGB = RGB(222, 226, 255)
        End Select
    Next i
    
    
    ' Création du graphique 2
    startRow = 3
    startCol = 10
    For i = 0 To rs2.Fields.Count - 1
        ws.Cells(startRow, startCol + i).Value = rs2.Fields(i).Name
    Next i
    ws.Cells(startRow + 1, startCol).CopyFromRecordset rs2

    lastRow = ws.Cells(ws.Rows.Count, startCol).End(xlUp).Row
    Set dataRange = ws.Range(ws.Cells(startRow, startCol), ws.Cells(lastRow, startCol + 1))
    
    ' Créer le graphique2
    Set chartObj2 = ws.ChartObjects.Add(Left:=350, Top:=110, Width:=300, Height:=300)
    With chartObj2.Chart
        .ChartType = xlColumnClustered
        .SetSourceData dataRange
        .HasTitle = True
        .ChartTitle.Text = "Nombre de compte par statut"
        .HasLegend = False
        .ChartGroups(1).GapWidth = 30
    End With
    
    With chartObj2.Chart
    .HasTitle = True
    .ChartTitle.Font.Size = 12
    .ChartTitle.Font.Bold = True
    .ChartTitle.Font.Color = RGB(0, 0, 128)
End With
    
    chartObj2.Chart.Axes(xlValue).Delete
    chartObj2.Chart.Axes(xlValue).MajorGridlines.Format.Line.Visible = msoFalse
    chartObj2.Chart.Axes(xlCategory).MajorGridlines.Delete '
    
    ' Ajouter les labels et couleurs
    With chartObj2.Chart.SeriesCollection(1)
        .ApplyDataLabels
        With .DataLabels
            .ShowValue = True
            .Position = xlLabelPositionInsideEnd
        End With
    End With

    Set s = chartObj2.Chart.SeriesCollection(1)
    For i = 1 To s.Points.Count
        Select Case LCase(Trim(s.XValues(i)))
            Case "ouvert":  s.Points(i).Format.Fill.ForeColor.RGB = RGB(142, 154, 175)
            Case "dormant": s.Points(i).Format.Fill.ForeColor.RGB = RGB(203, 192, 211)
            Case "no débit": s.Points(i).Format.Fill.ForeColor.RGB = RGB(239, 211, 215)
            Case "fermé":   s.Points(i).Format.Fill.ForeColor.RGB = RGB(254, 234, 250)
            Case Else:      s.Points(i).Format.Fill.ForeColor.RGB = RGB(222, 226, 255)
        End Select
    Next i
    
    
  ' Formatage du tableau de données
With Range("C3:D3")
    .Font.Name = "Calibri"
    .Font.Size = 11
    .Borders.LineStyle = xlContinuous
    .Interior.Color = MaPalette("lavande")
    .HorizontalAlignment = xlCenter
    .Columns.AutoFit
End With

With Range("C4:D7")
    .Font.Name = "Calibri"
    .Font.Size = 11
    .Borders.LineStyle = xlContinuous
    .Interior.Color = RGB(242, 242, 242)
    .HorizontalAlignment = xlCenter
End With

With Range("J3:K3")
    .Font.Name = "Calibri"
    .Font.Size = 11
    .Borders.LineStyle = xlContinuous
    .Interior.Color = MaPalette("lavande")
    .HorizontalAlignment = xlCenter
    .Columns.AutoFit
End With

With Range("J4:K7")
    .Font.Name = "Calibri"
    .Font.Size = 11
    .Borders.LineStyle = xlContinuous
    .Interior.Color = RGB(242, 242, 242)
    .HorizontalAlignment = xlCenter
End With


'Formatage du titre
With ws.Range("A1:N1")
   .Merge
   .Value = "Répartition des comptes et du solde moyen par statut"
   .Font.Bold = True
   .Font.Size = 16
   .Font.Name = "Calibri"
   .Font.Color = RGB(0, 0, 0)
   .Interior.Color = MaPalette("lavande")
   .HorizontalAlignment = xlCenter
   .VerticalAlignment = xlCenter
   .Borders.LineStyle = xlNone
   .RowHeight = 20
End With


  'Protéger les feuilles du classeur principal
    Call ProtegerToutesLesFeuillesDansClasseur(wbTemp, "tonMotDePasse")
    
  ' --- Sauvegarde dans dossier RapportExcel ---
    dossierBase = ThisWorkbook.Path
    If Right(dossierBase, 1) <> "\" Then dossierBase = dossierBase & "\"
    
    dossierRapport = dossierBase & "RapportExcel\"
    If Dir(dossierRapport, vbDirectory) = "" Then MkDir dossierRapport
    
    nomFichier = "Rapport_CompteStatut_" & Format(Date, "yyyymmdd") & ".xlsx"
    cheminComplet = dossierRapport & nomFichier
    
    ' Supprimer fichier existant si présent
    If Dir(cheminComplet) <> "" Then Kill cheminComplet
    
        
    ' Sauvegarder le classeur temporaire
    Application.DisplayAlerts = False
    wbTemp.SaveAs Filename:=cheminComplet, FileFormat:=xlOpenXMLWorkbook
    Application.DisplayAlerts = True
    
    wbTemp.Close SaveChanges:=False
    
    
    ' Nettoyage objets
    
    conn.Close
    Set rs = Nothing
    Set conn = Nothing
   
    MsgBox "Rapport généré avec succès", vbInformation
End Sub

 ``` 

Exportation des rapports au format PDF

L'utilisateur autorisé a la possibilité de

• Sélectionner le rapport de format excel à exporter
• Exporter le rapport au format pdf.

Sélection du rapport à exporter

Ouverture du rapport exporté

Script VBA d'exportation d'un rapport excel au format pdf

 ```vba

Sub ExporterFichierExcelEnPDF()
    Dim fd As FileDialog
    Dim cheminFichierExcel As String
    Dim nomFichierSansExt As String
    Dim dossierPDF As String
    Dim cheminFichierPDF As String
    Dim wbSource As Workbook
    Dim fichierOuvert As Boolean

    ' Boîte de dialogue pour choisir un fichier Excel
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = "Sélectionner le fichier Excel à exporter"
        .InitialFileName = ThisWorkbook.Path & "\RapportExcel\"
        .Filters.Clear
        .Filters.Add "Fichiers Excel", "*.xls; *.xlsx; *.xlsm"
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        cheminFichierExcel = .SelectedItems(1)
    End With

    ' Extraire le nom sans extension
    nomFichierSansExt = mid(Dir(cheminFichierExcel), 1, InStrRev(Dir(cheminFichierExcel), ".") - 1)

    ' Créer dossier RapportPDF si inexistant
    dossierPDF = ThisWorkbook.Path & "\RapportPDF"
    If Dir(dossierPDF, vbDirectory) = "" Then MkDir dossierPDF

    cheminFichierPDF = dossierPDF & "\" & nomFichierSansExt & ".pdf"

    Application.ScreenUpdating = False
    Set wbSource = Workbooks.Open(cheminFichierExcel)

    ' Vérifier si PDF est ouvert
    fichierOuvert = False
    If Dir(cheminFichierPDF) <> "" Then
        On Error Resume Next
        Open cheminFichierPDF For Binary Access Read Write Lock Read Write As #1
        If Err.Number <> 0 Then fichierOuvert = True
        Close #1
        On Error GoTo 0

        If fichierOuvert Then
            MsgBox "Le fichier PDF est déjà ouvert. Fermez-le puis recommencez.", vbExclamation
            wbSource.Close SaveChanges:=False
            Application.ScreenUpdating = True
            Exit Sub
        Else
            Kill cheminFichierPDF
        End If
    End If

    ' Mise en page avant export PDF
    With wbSource.Sheets(1).PageSetup
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .LeftFooter = "Créé le : &D"
        .RightFooter = "Page &P sur &N"
        .CenterFooter = ""
    End With

    ' Exporter la première feuille en PDF
    wbSource.Sheets(1).ExportAsFixedFormat Type:=xlTypePDF, Filename:=cheminFichierPDF, Quality:=xlQualityStandard

    ' Ouvrir l'explorateur et sélectionner le PDF
    Shell "explorer.exe /select,""" & cheminFichierPDF & """", vbNormalFocus

    wbSource.Close SaveChanges:=False
    Application.ScreenUpdating = True

    MsgBox "Exportation en PDF réussie." & vbCrLf & cheminFichierPDF, vbInformation
End Sub
 ``` 

Transmission des rapports au format PDF par email

L'utilisateur autorisé a la possibilité de

• Retrouver le rapport pdf souhaité à travers un répertoire
• Saisir l'email du destinataire
• Expedier le rapport en attachement.

Sélection du rapport pdf à transmettre

Saisie de l'adresse e-mail du destinataire

Vérification de la reception du message

Ouverture de rapport attaché

Script VBA de la transmission par e-mail

 ```vba

Sub EnvoyerPDFParGmail()
    Dim fichierPDF As String
    Dim destinataire As String
    Dim sujet As String
    Dim message As String
    Dim username As String
    Dim motDePasse As String
    
    ' Étape 1 : Choisir le fichier PDF
    fichierPDF = Application.GetOpenFilename("Fichiers PDF (*.pdf), *.pdf", , "Sélectionnez un rapport PDF")
    
    If fichierPDF = "Faux" Then
        MsgBox "Aucun fichier sélectionné.", vbExclamation
        Exit Sub
    End If
    
    ' Étape 2 : Paramètres de l’e-mail
    destinataire = InputBox("Adresse e-mail du destinataire :", "Envoyer PDF")
    If destinataire = "" Then Exit Sub
    
    sujet = "Rapport PDF"
    message = "Veuillez trouver ci-joint le rapport demandé."

    ' Étape 3 : Configuration CDO pour Gmail
    Dim CDOmsg As Object
    Dim CDOconf As Object
    Dim champsConfig As Object
    
    Set CDOmsg = CreateObject("CDO.Message")
    Set CDOconf = CreateObject("CDO.Configuration")
    Set champsConfig = CDOconf.Fields
    
    With champsConfig
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "valcourth@gmail.com"
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "*************"
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Update
    End With
    
 
    With CDOmsg
        Set .Configuration = CDOconf
        .To = destinataire
        .From = username
        .Subject = sujet
        .TextBody = message
        .AddAttachment fichierPDF
        .Send
    End With

    MsgBox "E-mail envoyé avec succès à " & destinataire, vbInformation
End Sub
 ``` 

Sécurisation de l'application

Les dispositions de sécurité sont mises en place au niveau de la base de données et au niveau d'Excel.

• Contrôle d’accès Oracle ( création des utilisateurs dédiés,affectation des rôles et profils).
• Authentification et contrôle de profil dans l’application (création des utilisateurs avec mot de passe encodé et formulaires sécurisés).
• Acces aux Dasboards et rapports enfonction du profil utilisateur
• Connexion et requêtes sécurisées (pas d’injection SQL).
• Protection du workbook (script VBA permettant de protéger/déprotéger les rapports et dashboards).
• Protection des fichiers excel et pdf générés dans des dossiers dédiés(script VBA de protéger/déprotéger les dossiers par mots de passe).

Protection des feuilles et des dossiers

La protection des feuilles et des dossiers est réalisée l'administrateur. Les étapes sont les suivantes:

• Connexion à l'application
• Ouvrir le formulaire de protection des feuilles
• Saisir le mot de passe stocké pour protection
• Lancer la protection des rapports et dossiers

Scripts VBA de protection des dashboards et feuilles de rapport

 ```vba

Private Sub btnProteger_Click()
    Dim mdp As String
    Dim feuilleParam As Worksheet

    mdp = Trim(Me.txtMotDePasse.Value)
    If mdp = "" Then
        MsgBox "Veuillez saisir un mot de passe.", vbExclamation
        Exit Sub
    End If

    Set feuilleParam = ThisWorkbook.Worksheets("FeuilParam")

    ' Déprotéger FeuilParam si protégée (ajuste le mot de passe si nécessaire)
    On Error Resume Next
    feuilleParam.Unprotect Password:=feuilleParam.Range("A4").Value
    On Error GoTo 0

    ' Enregistrer le mot de passe saisi
    feuilleParam.Range("A4").Value = mdp

    ' Reprotéger FeuilParam avec le nouveau mot de passe
    feuilleParam.Protect Password:=mdp, UserInterfaceOnly:=True

    ' Appeler la procédure qui protège toutes les feuilles avec ce mot de passe
    Call ProtegerToutesLesFeuillesAvecMdp(mdp)
   
    MsgBox "Mot de passe enregistré et feuilles protégées.", vbInformation

    Me.Hide
End Sub
 ``` 

 ```vba

Sub ProtegerToutesLesFeuillesAvecMdp(mdp As String)
    Dim ws As Worksheet
    Dim feuilleParam As Worksheet
    Dim etatVisible As XlSheetVisibility

    On Error Resume Next
    Set feuilleParam = ThisWorkbook.Worksheets("FeuilParam")
    On Error GoTo 0

    If feuilleParam Is Nothing Then
        MsgBox "La feuille 'FeuilParam' est introuvable.", vbCritical
        Exit Sub
    End If

    ' Sauvegarde l'état de visibilité
    etatVisible = feuilleParam.Visible

    ' Rendre la feuille visible et non protégée
    With feuilleParam
        .Visible = xlSheetVisible
        .Unprotect Password:=mdp ' si elle est protégée avec ce mot de passe
        .Range("A4").Value = mdp
        .Protect Password:=mdp, UserInterfaceOnly:=True
        .Visible = etatVisible ' remet l'état d'origine
    End With

    ' Protéger toutes les feuilles sauf FeuilParam
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "FeuilParam" Then
            ws.Protect Password:=mdp, UserInterfaceOnly:=True
        End If
    Next ws

    MsgBox "Toutes les feuilles ont été protégées.", vbInformation
End Sub

 ``` 

 ```vba

Sub ProtegerFeuillesClasseur(wb As Workbook, motDePasse As String)
    Dim ws As Worksheet
    
    Application.ScreenUpdating = False
    On Error Resume Next
    
    For Each ws In wb.Worksheets
        With ws
            If .ProtectContents Then
                .Unprotect Password:=motDePasse
            End If
            .Protect Password:=motDePasse, _
                     DrawingObjects:=True, _
                     Contents:=True, _
                     Scenarios:=True, _
                     AllowFiltering:=True, _
                     AllowSorting:=True, _
                     AllowUsingPivotTables:=True
        End With
    Next ws
    
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub
 ```