'===============================================================================
' Module: DiviseurPPTX_v2
' Description: Divise une présentation PowerPoint externe en fichiers individuels
'              Sélectionne un fichier .pptx depuis un fichier central .pptm
' Auteur: LivreConnect
' Date: Février 2026
'===============================================================================

Option Explicit

'===============================================================================
' Procédure principale : Diviser une présentation externe sélectionnée
'===============================================================================
Sub DiviserPresentationExterne()
    Dim presSource As Presentation
    Dim presNouvelle As Presentation
    Dim presModele As Presentation
    Dim slideSource As Slide
    Dim slideNouvelle As Slide
    Dim fichierSource As String
    Dim fichierModele As String
    Dim cheminSortie As String
    Dim nomFichierBase As String
    Dim nomComplet As String
    Dim i As Long
    Dim nombreDiapos As Long
    Dim compteurReussite As Long
    Dim formatNumero As String
    Dim reponse As VbMsgBoxResult
    Dim dialogFichier As FileDialog
    Dim dialogDossier As FileDialog
    Dim dialogModele As FileDialog
    Dim prefixe As String
    Dim utiliserModele As Boolean
    
    ' Désactiver les alertes et l'affichage

    Application.DisplayAlerts = ppAlertsNone
    
    On Error GoTo GestionErreur
    
    ' ========================================================================
    ' ÉTAPE 01 : Sélectionner le fichier PowerPoint à diviser
    ' ========================================================================
    Set dialogFichier = Application.FileDialog(msoFileDialogFilePicker)
    
    With dialogFichier
        .Title = "Sélectionne la présentation à diviser"
        .Filters.Clear
        .Filters.Add "Présentations PowerPoint", "*.pptx; *.pptm", 1
        .AllowMultiSelect = False
        
        If .Show = -1 Then
            fichierSource = .SelectedItems(1)
        Else
        
            Application.DisplayAlerts = ppAlertsAll
            Exit Sub
        End If
    End With
    
    ' Ouvrir la présentation (en arrière-plan, pas visible)
Set presSource = Presentations.Open(FileName:=fichierSource, ReadOnly:=msoTrue)
    
    nombreDiapos = presSource.Slides.Count
    
    ' Vérifier qu'il y a des diapositives
    If nombreDiapos = 0 Then
        presSource.Close
        MsgBox "La présentation ne contient aucune diapositive.", _
               vbExclamation, "LivreConnect - Diviseur PowerPoint"
    
        Application.DisplayAlerts = ppAlertsAll
        Exit Sub
    End If
    
    ' ========================================================================
    ' ÉTAPE 02 : Sélectionner le dossier de sortie
    ' ========================================================================
    Set dialogDossier = Application.FileDialog(msoFileDialogFolderPicker)
    
    With dialogDossier
        .Title = "Sélectionne le dossier de sortie"
        .InitialFileName = presSource.Path
        
        If .Show = -1 Then
            cheminSortie = .SelectedItems(1) & "\"
        Else
            presSource.Close
        
            Application.DisplayAlerts = ppAlertsAll
            Exit Sub
        End If
    End With
    
    ' ========================================================================
    ' ÉTAPE 03 : Sélectionner un modèle (optionnel)
    ' ========================================================================
    reponse = MsgBox("Voulez-vous appliquer un modèle de présentation aux diapositives extraites ?" & vbCrLf & vbCrLf & _
                     "Oui = Choisir un modèle (.pptx ou .potx)" & vbCrLf & _
                     "Non = Garder le design original", _
                     vbQuestion + vbYesNo, "LivreConnect - Modèle")
    
    utiliserModele = False
    fichierModele = ""
    
    If reponse = vbYes Then
        Set dialogModele = Application.FileDialog(msoFileDialogFilePicker)
        
        With dialogModele
            .Title = "Sélectionne le modèle de présentation"
            .Filters.Clear
            .Filters.Add "Modèles PowerPoint", "*.pptx; *.potx; *.pptm", 1
            .AllowMultiSelect = False
            
            If .Show = -1 Then
                fichierModele = .SelectedItems(1)
                utiliserModele = True
            End If
        End With
    End If
    
    ' ========================================================================
    ' ÉTAPE 04 : Définir la nomenclature
    ' ========================================================================
    
    ' Extraire le nom de base du fichier
    nomFichierBase = Left(presSource.Name, InStrRev(presSource.Name, ".") - 1)
    
    ' Demander le préfixe (ex: LC_Auteurs_Module01)
    prefixe = InputBox("Préfixe pour les fichiers :" & vbCrLf & vbCrLf & _
                       "Exemple : LC_Auteurs_Module01" & vbCrLf & _
                       "Résultat : LC_Auteurs_Module01_diapo_01.pptx" & vbCrLf & vbCrLf & _
                       "Laisse vide pour utiliser le nom du fichier.", _
                       "LivreConnect - Nomenclature", _
                       "LC_" & nomFichierBase)
    
    ' Si vide, utiliser le nom du fichier
    If prefixe = "" Then
        prefixe = nomFichierBase
    End If
    
    ' ========================================================================
    ' ÉTAPE 05 : Confirmation
    ' ========================================================================
    Dim msgModele As String
    If utiliserModele Then
        msgModele = "Modèle : " & Mid(fichierModele, InStrRev(fichierModele, "\") + 1)
    Else
        msgModele = "Modèle : (design original)"
    End If
    
    reponse = MsgBox("Prêt à diviser la présentation ?" & vbCrLf & vbCrLf & _
                     "Fichier : " & presSource.Name & vbCrLf & _
                     "Diapositives : " & nombreDiapos & vbCrLf & _
                     "Dossier : " & cheminSortie & vbCrLf & _
                     "Nomenclature : " & prefixe & "_diapo_XX.pptx" & vbCrLf & _
                     msgModele, _
                     vbQuestion + vbYesNo, "LivreConnect - Diviseur PowerPoint")
    
    If reponse = vbNo Then
        presSource.Close
    
        Application.DisplayAlerts = ppAlertsAll
        Exit Sub
    End If
    
    ' ========================================================================
    ' ÉTAPE 06 : Extraction
    ' ========================================================================
    
    ' Déterminer le format de numérotation
    If nombreDiapos < 100 Then
        formatNumero = "00"
    Else
        formatNumero = "000"
    End If
    
    ' Initialiser le compteur
    compteurReussite = 0
    
    ' Boucle sur chaque diapositive
    For i = 1 To nombreDiapos
        On Error Resume Next
        Err.Clear
        
        ' DEBUG: Afficher quelle diapo on traite (à supprimer après debug)
        ' MsgBox "Traitement diapo " & i & " / " & nombreDiapos, vbInformation
        
        ' Créer une nouvelle présentation basée sur le modèle ou vide
        If utiliserModele And fichierModele <> "" Then
            ' Ouvrir le modèle et en faire une copie
            Set presNouvelle = Application.Presentations.Open(FileName:=fichierModele, ReadOnly:=msoFalse, WithWindow:=msoTrue)
            
            If Err.Number <> 0 Then
                MsgBox "Erreur ouverture modèle diapo " & i & ": " & Err.Description, vbCritical
                Err.Clear
                GoTo ProchaineDiapo
            End If
            
            ' Supprimer toutes les diapositives du modèle
            Do While presNouvelle.Slides.Count > 0
                presNouvelle.Slides(1).Delete
            Loop
            Err.Clear
        Else
            ' Créer une nouvelle présentation vide (avec fenêtre pour éviter les problèmes de collage)
            Set presNouvelle = Application.Presentations.Add(msoTrue)
            
            If Err.Number <> 0 Then
                MsgBox "Erreur création présentation diapo " & i & ": " & Err.Description, vbCritical
                Err.Clear
                GoTo ProchaineDiapo
            End If
            
            ' Copier les dimensions de la source
            presNouvelle.PageSetup.SlideWidth = presSource.PageSetup.SlideWidth
            presNouvelle.PageSetup.SlideHeight = presSource.PageSetup.SlideHeight
            
            ' Supprimer la diapositive par défaut créée automatiquement
            If presNouvelle.Slides.Count > 0 Then
                presNouvelle.Slides(1).Delete
            End If
            Err.Clear
        End If
        
        ' Copier la diapositive source
        Set slideSource = presSource.Slides(i)
        slideSource.Copy
        
        If Err.Number <> 0 Then
            MsgBox "Erreur copie diapo " & i & ": " & Err.Description, vbCritical
            Err.Clear
            presNouvelle.Close
            GoTo ProchaineDiapo
        End If
        
        ' Petit délai pour laisser le presse-papiers se remplir
        DoEvents
        Application.Wait Now + TimeValue("00:00:01")
        
        ' Coller dans la nouvelle présentation (garder le formatage source ou utiliser le thème destination)
        If utiliserModele Then
            ' Coller en utilisant le thème du modèle destination
            presNouvelle.Slides.Paste
            ' Appliquer le design du modèle à la diapositive collée
            If presNouvelle.Slides.Count > 0 Then
                ' La diapositive hérite automatiquement du thème du modèle
            End If
        Else
            ' Coller en gardant le formatage source
            presNouvelle.Slides.Paste
        End If
        
        If Err.Number <> 0 Then
            MsgBox "Erreur collage diapo " & i & ": " & Err.Description, vbCritical
            Err.Clear
            presNouvelle.Close
            GoTo ProchaineDiapo
        End If
        
        ' Vérifier qu'on a bien une diapositive
        If presNouvelle.Slides.Count = 0 Then
            MsgBox "Aucune diapositive collée pour diapo " & i, vbCritical
            presNouvelle.Close
            GoTo ProchaineDiapo
        End If
        
        ' Construire le nom du fichier
        nomComplet = cheminSortie & prefixe & "_diapo_" & _
                     Format(i, formatNumero) & ".pptx"
        
        ' Sauvegarder
        presNouvelle.SaveAs nomComplet, ppSaveAsOpenXMLPresentation
        
        If Err.Number <> 0 Then
            MsgBox "Erreur sauvegarde diapo " & i & ": " & Err.Description & vbCrLf & "Chemin: " & nomComplet, vbCritical
            Err.Clear
            presNouvelle.Close
            GoTo ProchaineDiapo
        End If
        
        ' Fermer la présentation
        presNouvelle.Close
        
        ' Incrémenter le compteur si succès
        compteurReussite = compteurReussite + 1
        
ProchaineDiapo:
        On Error GoTo GestionErreur
    Next i
    
    ' Fermer la présentation source
    presSource.Close
    
    ' ========================================================================
    ' ÉTAPE 07 : Résultat
    ' ========================================================================

    Application.DisplayAlerts = ppAlertsAll
    
    MsgBox "Extraction terminée !" & vbCrLf & vbCrLf & _
           "Fichier traité : " & fichierSource & vbCrLf & _
           "Diapositives extraites : " & compteurReussite & " / " & nombreDiapos & vbCrLf & _
           "Dossier de sortie : " & cheminSortie, _
           vbInformation, "LivreConnect - Diviseur PowerPoint"
    
    Exit Sub

GestionErreur:

    Application.DisplayAlerts = ppAlertsAll
    
    ' Fermer la présentation source si elle est ouverte
    On Error Resume Next
    If Not presSource Is Nothing Then
        presSource.Close
    End If
    
    MsgBox "Erreur lors de la division :" & vbCrLf & vbCrLf & _
           "Numéro : " & Err.Number & vbCrLf & _
           "Description : " & Err.Description, _
           vbCritical, "LivreConnect - Diviseur PowerPoint"
End Sub

'===============================================================================
' Procédure batch : Diviser plusieurs présentations d'un dossier
'===============================================================================
Sub DiviserPresentationsBatch()
    Dim dialogDossierSource As FileDialog
    Dim dialogDossierSortie As FileDialog
    Dim dossierSource As String
    Dim dossierSortie As String
    Dim fichier As String
    Dim compteurFichiers As Long
    Dim compteurReussite As Long
    Dim prefixeGlobal As String
    Dim reponse As VbMsgBoxResult
    
    On Error GoTo GestionErreur
    
    ' Sélectionner le dossier source
    Set dialogDossierSource = Application.FileDialog(msoFileDialogFolderPicker)
    
    With dialogDossierSource
        .Title = "Sélectionne le dossier contenant les présentations"
        
        If .Show = -1 Then
            dossierSource = .SelectedItems(1) & "\"
        Else
            Exit Sub
        End If
    End With
    
    ' Sélectionner le dossier de sortie
    Set dialogDossierSortie = Application.FileDialog(msoFileDialogFolderPicker)
    
    With dialogDossierSortie
        .Title = "Sélectionne le dossier de sortie (un sous-dossier par présentation)"
        .InitialFileName = dossierSource
        
        If .Show = -1 Then
            dossierSortie = .SelectedItems(1) & "\"
        Else
            Exit Sub
        End If
    End With
    
    ' Préfixe global optionnel
    prefixeGlobal = InputBox("Préfixe global pour tous les fichiers :" & vbCrLf & _
                             "(ex: LC_Auteurs_)" & vbCrLf & vbCrLf & _
                             "Laisse vide pour utiliser les noms de fichiers.", _
                             "LivreConnect - Préfixe batch", _
                             "LC_")
    
    ' Confirmation
    reponse = MsgBox("Traiter toutes les présentations du dossier ?" & vbCrLf & vbCrLf & _
                     "Source : " & dossierSource & vbCrLf & _
                     "Sortie : " & dossierSortie & vbCrLf & _
                     "Préfixe : " & prefixeGlobal, _
                     vbQuestion + vbYesNo, "LivreConnect - Batch")
    
    If reponse = vbNo Then Exit Sub
    

    Application.DisplayAlerts = ppAlertsNone
    
    ' Parcourir tous les fichiers .pptx et .pptm
    compteurFichiers = 0
    compteurReussite = 0
    
    fichier = Dir(dossierSource & "*.pptx")
    
    Do While fichier <> ""
        compteurFichiers = compteurFichiers + 1
        
        ' Traiter ce fichier
        If TraiterFichierBatch(dossierSource & fichier, _
                               dossierSortie, _
                               prefixeGlobal) Then
            compteurReussite = compteurReussite + 1
        End If
        
        fichier = Dir()
    Loop
    
    ' Traiter aussi les .pptm
    fichier = Dir(dossierSource & "*.pptm")
    
    Do While fichier <> ""
        compteurFichiers = compteurFichiers + 1
        
        If TraiterFichierBatch(dossierSource & fichier, _
                               dossierSortie, _
                               prefixeGlobal) Then
            compteurReussite = compteurReussite + 1
        End If
        
        fichier = Dir()
    Loop
    

    Application.DisplayAlerts = ppAlertsAll
    
    MsgBox "Traitement batch terminé !" & vbCrLf & vbCrLf & _
           "Présentations traitées : " & compteurReussite & " / " & compteurFichiers & vbCrLf & _
           "Dossier de sortie : " & dossierSortie, _
           vbInformation, "LivreConnect - Batch"
    
    Exit Sub

GestionErreur:

    Application.DisplayAlerts = ppAlertsAll
    
    MsgBox "Erreur batch : " & Err.Description, vbCritical
End Sub

'===============================================================================
' Fonction auxiliaire : Traiter un fichier pour le batch
'===============================================================================
Private Function TraiterFichierBatch(fichierSource As String, _
                                     dossierSortieBase As String, _
                                     prefixeGlobal As String) As Boolean
    Dim presSource As Presentation
    Dim presNouvelle As Presentation
    Dim slideSource As Slide
    Dim slideNouvelle As Slide
    Dim nomFichierBase As String
    Dim sousDossier As String
    Dim nomComplet As String
    Dim i As Long
    Dim nombreDiapos As Long
    Dim formatNumero As String
    Dim prefixe As String
    
    On Error GoTo GestionErreurFichier
    
    ' Ouvrir la présentation
    Set presSource = Application.Presentations.Open(fichierSource, _
                                                     ReadOnly:=msoTrue, _
                                                     Untitled:=msoTrue, _
                                                     WithWindow:=msoFalse)
    
    nombreDiapos = presSource.Slides.Count
    
    If nombreDiapos = 0 Then
        presSource.Close
        TraiterFichierBatch = False
        Exit Function
    End If
    
    ' Extraire le nom de base
    nomFichierBase = Left(presSource.Name, InStrRev(presSource.Name, ".") - 1)
    
    ' Créer un sous-dossier pour cette présentation
    sousDossier = dossierSortieBase & nomFichierBase & "\"
    
    ' Créer le dossier s'il n'existe pas
    On Error Resume Next
    MkDir sousDossier
    On Error GoTo GestionErreurFichier
    
    ' Déterminer le préfixe
    If prefixeGlobal <> "" Then
        prefixe = prefixeGlobal & nomFichierBase
    Else
        prefixe = nomFichierBase
    End If
    
    ' Format numérotation
    If nombreDiapos < 100 Then
        formatNumero = "00"
    Else
        formatNumero = "000"
    End If
    
    ' Extraire chaque diapositive
    For i = 1 To nombreDiapos
        On Error Resume Next
        Err.Clear
        
        ' Créer une nouvelle présentation (avec fenêtre pour le collage)
        Set presNouvelle = Application.Presentations.Add(msoTrue)
        
        If Err.Number <> 0 Then
            Err.Clear
            GoTo ProchaineDiapoBatch
        End If
        
        presNouvelle.PageSetup.SlideWidth = presSource.PageSetup.SlideWidth
        presNouvelle.PageSetup.SlideHeight = presSource.PageSetup.SlideHeight
        
        ' Supprimer la diapositive par défaut
        If presNouvelle.Slides.Count > 0 Then
            presNouvelle.Slides(1).Delete
        End If
        
        Set slideSource = presSource.Slides(i)
        slideSource.Copy
        DoEvents
        
        ' Coller dans la nouvelle présentation
        presNouvelle.Slides.Paste
        
        If Err.Number <> 0 Then
            Err.Clear
            presNouvelle.Close
            GoTo ProchaineDiapoBatch
        End If
        
        nomComplet = sousDossier & prefixe & "_diapo_" & _
                     Format(i, formatNumero) & ".pptx"
        
        presNouvelle.SaveAs nomComplet, ppSaveAsOpenXMLPresentation
        presNouvelle.Close
        
ProchaineDiapoBatch:
        On Error GoTo GestionErreurFichier
    Next i
    
    presSource.Close
    
    TraiterFichierBatch = True
    Exit Function

GestionErreurFichier:
    On Error Resume Next
    If Not presSource Is Nothing Then
        presSource.Close
    End If
    TraiterFichierBatch = False
End Function

'===============================================================================
' Procédure : Créer le fichier de suivi Excel
'===============================================================================
Sub CreerFichierSuivi()
    Dim dialogDossier As FileDialog
    Dim cheminSortie As String
    Dim xlApp As Object
    Dim xlWorkbook As Object
    Dim xlSheet As Object
    
    On Error GoTo GestionErreur
    
    ' Sélectionner le dossier de sortie
    Set dialogDossier = Application.FileDialog(msoFileDialogFolderPicker)
    
    With dialogDossier
        .Title = "Où créer le fichier de suivi Excel ?"
        
        If .Show = -1 Then
            cheminSortie = .SelectedItems(1) & "\LivreConnect_Suivi_Extractions.xlsx"
        Else
            Exit Sub
        End If
    End With
    
    ' Créer Excel
    Set xlApp = CreateObject("Excel.Application")
    Set xlWorkbook = xlApp.Workbooks.Add
    Set xlSheet = xlWorkbook.Sheets(1)
    
    ' En-têtes
    With xlSheet
        .Name = "Suivi général"
        .Range("A1").Value = "ID"
        .Range("B1").Value = "Présentation source"
        .Range("C1").Value = "Persona"
        .Range("D1").Value = "Module"
        .Range("E1").Value = "Niveau"
        .Range("F1").Value = "Nb diapos"
        .Range("G1").Value = "Statut"
        .Range("H1").Value = "Date extraction"
        .Range("I1").Value = "Dossier destination"
        .Range("J1").Value = "Valeur Plumes"
        .Range("K1").Value = "Notes"
        
        ' Mise en forme
        .Range("A1:K1").Font.Bold = True
        .Range("A1:K1").Interior.Color = RGB(68, 114, 196)
        .Range("A1:K1").Font.Color = RGB(255, 255, 255)
        .Columns("A:K").AutoFit
    End With
    
    ' Sauvegarder
    xlWorkbook.SaveAs cheminSortie
    xlApp.Visible = True
    
    MsgBox "Fichier de suivi créé !" & vbCrLf & vbCrLf & _
           "Chemin : " & cheminSortie, _
           vbInformation, "LivreConnect"
    
    ' Libérer les objets Excel
    Set xlSheet = Nothing
    Set xlWorkbook = Nothing
    Set xlApp = Nothing
    
    Exit Sub

GestionErreur:
    MsgBox "Erreur création fichier : " & Err.Description, vbCritical
    
    On Error Resume Next
    If Not xlWorkbook Is Nothing Then
        xlWorkbook.Close SaveChanges:=False
    End If
    If Not xlApp Is Nothing Then
        xlApp.Quit
    End If
    Set xlSheet = Nothing
    Set xlWorkbook = Nothing
    Set xlApp = Nothing
End Sub