1
votes

Comment puis-je diviser un fichier PowerPoint avec plusieurs diapositives en plusieurs fichiers de 1 diapositive chacun?

J'ai un fichier contenant 50 diapositives. J'ai besoin de créer 50 fichiers différents contenant chacun l'une des diapositives. Je suppose que le moyen le plus rapide inclut VBA, mais je ne sais pas comment demander à VBA de créer un nouveau fichier, puis de revenir au maître.

vba powerpoint

1 commentaires

boucle sur les diapositives, ajouter une nouvelle présentation à chaque itération, copier la diapositive dans une nouvelle présentation, enregistrer, fermer une nouvelle présentation.

3 Réponses :

5
votes

En supposant que vous vouliez dire "créer 50 présentations", cela fonctionnera. Créez le dossier de destination avant d'exécuter le code:

Sub ExportSlides()
  For X = 1 To ActivePresentation.Slides.Count
    ActivePresentation.Slides(X).Export "c:\temp\slide" & X & ".pptx", "PPTX"
  Next X
End Sub

0 commentaires

0
votes

J'ai enfin découvert ceci:

Sub ExportSlides()
    Dim oTempPres As Presentation
    Dim X As Long
    For X = 1 To ActivePresentation.Slides.Count
        sFileName = "C:\Raw\Slide__" & X & ".pptx"
        ActivePresentation.SaveCopyAs sFileName

        Set oTempPres = Presentations.Open(sFileName, , , False)
        
        For Y = (X + 1) To oTempPres.Slides.Count
            oTempPres.Slides(X + 1).Delete
        Next
        
        For Y = 1 To X - 1
            oTempPres.Slides(1).Delete
        Next
        
        oTempPres.Save
        oTempPres.Close
        
    Next X
End Sub

1 commentaires

Où l'as tu trouvé?

0
votes

Ce code que j'avais pour un projet similaire devrait fonctionner pour diviser chaque fichier PPT dans son fichier PPT et l'enregistrer dans le dossier qui contient le fichier PPT d'origine.

Quelques mises en garde:

il a du mal avec les graphiques intégrés et parfois les arrière-plans.
cela supprime toutes les animations affectées aux diapositives ou au modèle. Si vous souhaitez conserver des animations ou des effets, supprimez simplement ces lignes de code
Je n'ai pas pris le temps d'automatiser l'affichage automatique du formulaire utilisateur, mais vous pouvez facilement l'exécuter en allant dans l'onglet Développeur et en exécutant le sous-programme OnPresentationOpen à partir de la liste des macros.

En fonction des paramètres de sécurité de votre environnement, vous devrez peut-être également définir le .pptm contenant ce VBA en tant que document de confiance avant qu'il ne fonctionne.

Option Explicit
Sub OnPresentationOpen()
    UserForm1.Show
End Sub

Public Sub ProcessPowerPoint(pptCalled)
    Dim pptMainPowerPt As Presentation
    Dim slideCount As Long
    Dim i As Long
    Dim cleanSlide As Slide
    Dim newSaveName As String
    
    Set pptMainPowerPt = Presentations.Open(pptCalled)
    slideCount = ActivePresentation.Slides.Count
    
    ' Removes all animations from entire document first
    For Each cleanSlide In ActivePresentation.Slides
        For i = cleanSlide.TimeLine.MainSequence.Count To 1 Step -1
            'Remove Each Animation
            cleanSlide.TimeLine.MainSequence.Item(i).Delete
        Next i
    Next cleanSlide
    
    Debug.Print "The number of slides is "; slideCount
    Debug.Print "The name that is showing is "; pptCalled
    Debug.Print ActivePresentation.Name
    
    newSaveName = Left(pptCalled, InStr(pptCalled, ".") - 1)
    
    Debug.Print "Substring name is "; newSaveName
    
    For i = 1 To slideCount
        Dim newPresentation As Presentation
        Dim newName As String
        Dim currentSlide As Slide
         
        newName = newSaveName + "_Slide_" & i & ".pptx"
      
        Set currentSlide = pptMainPowerPt.Slides.Item(i)
        Set newPresentation = Application.Presentations.Add
        currentSlide.Copy
        newPresentation.Slides.Paste
        
       newPresentation.SaveAs (newName)
       newPresentation.Close
          
    Next
  
    pptMainPowerPt.Close
    
End Sub

p >

0 commentaires