combiner plusieurs diapositives de programmation des présentations dans une présentation unique
-
24-10-2019 - |
Question
Je dois automatiser la création d'une présentation (soit OpenOffice ou Powerpoint). La présentation devrait prendre les deux premières diapositives de chacune des présentations dans un répertoire donné, puis les combiner en une seule présentation. Je suis confus quant à l'approche que je devrais prendre pour résoudre ce problème. Tous les pointeurs seront appréciés.
La solution
En parlant de PowerPoint, vous pouvez utiliser une macro VBA pour faire le travail, quelque chose comme
Sub Pull()
Dim SrcDir As String, SrcFile As String
SrcDir = PickDir()
If SrcDir = "" Then Exit Sub
SrcFile = Dir(SrcDir & "\*.ppt")
Do While SrcFile <> ""
ImportFromPPT SrcDir + "\" + SrcFile, 1, 2
SrcFile = Dir()
Loop
End Sub
Sélection de votre répertoire source, vous pouvez utiliser cette fonction
Private Function PickDir() As String
Dim FD As FileDialog
PickDir = ""
Set FD = Application.FileDialog(msoFileDialogFolderPicker)
With FD
.Title = "Pick a directory to work on"
.AllowMultiSelect = False
.Show
If .SelectedItems.Count <> 0 Then
PickDir = .SelectedItems(1)
End If
End With
End Function
- le point principal est d'insérer des diapositives d'une autre PPT alors que en conservant le format source . Ceci est une chose délicate, comme la méthode InsertFromFile
PPT VBA est pas bon usage. Microsoft nous a donné un bon temps pour comprendre la dure dans d'innombrables sessions :-) 20hrs debug et vous avez besoin de taper beaucoup de code pour le faire correctement - beaucoup plus compliqué que d'utiliser le dialogue manuellement, en particulier si votre diapositive source écarte de votre diapositive maître source.
Si votre PPT de collent à leurs maîtres, vous pouvez en toute sécurité omettre tout le code entre le « >>>> »
Private Sub ImportFromPPT(FileName As String, SlideFrom As Long, SlideTo As Long)
Dim SrcPPT As Presentation, SrcSld As Slide, Idx As Long, SldCnt As Long
Set SrcPPT = Presentations.Open(FileName, , , msoFalse)
SldCnt = SrcPPT.Slides.Count
If SlideFrom > SldCnt Then Exit Sub
If SlideTo > SldCnt Then SlideTo = SldCnt
For Idx = SlideFrom To SlideTo Step 1
Set SrcSld = SrcPPT.Slides(Idx)
SrcSld.Copy
With ActivePresentation.Slides.Paste
.Design = SrcSld.Design
.ColorScheme = SrcSld.ColorScheme
' if slide is not following its master (design, color scheme)
' we must collect all bits & pieces from the slide itself
' >>>>>>>>>>>>>>>>>>>>
If SrcSld.FollowMasterBackground = False Then
.FollowMasterBackground = False
.Background.Fill.Visible = SrcSld.Background.Fill.Visible
.Background.Fill.ForeColor = SrcSld.Background.Fill.ForeColor
.Background.Fill.BackColor = SrcSld.Background.Fill.BackColor
' inspect the FillType object
Select Case SrcSld.Background.Fill.Type
Case Is = msoFillTextured
Select Case SrcSld.Background.Fill.TextureType
Case Is = msoTexturePreset
.Background.Fill.PresetTextured (SrcSld.Background.Fill.PresetTexture)
Case Is = msoTextureUserDefined
' TextureName gives a filename w/o path
' not implemented, see picture handling
End Select
Case Is = msoFillSolid
.Background.Fill.Transparency = 0#
.Background.Fill.Solid
Case Is = msoFillPicture
' picture cannot be copied directly, need to export and re-import slide image
If SrcSld.Shapes.Count > 0 Then SrcSld.Shapes.Range.Visible = False
bMasterShapes = SrcSld.DisplayMasterShapes
SrcSld.DisplayMasterShapes = False
SrcSld.Export SrcPPT.Path & SrcSld.SlideID & ".png", "PNG"
.Background.Fill.UserPicture SrcPPT.Path & SrcSld.SlideID & ".png"
Kill (SrcPPT.Path & SrcSld.SlideID & ".png")
SrcSld.DisplayMasterShapes = bMasterShapes
If SrcSld.Shapes.Count > 0 Then SrcSld.Shapes.Range.Visible = True
Case Is = msoFillPatterned
.Background.Fill.Patterned (SrcSld.Background.Fill.Pattern)
Case Is = msoFillGradient
' inspect gradient type
Select Case SrcSld.Background.Fill.GradientColorType
Case Is = msoGradientTwoColors
.Background.Fill.TwoColorGradient
SrcSld.Background.Fill.GradientStyle , _
SrcSld.Background.Fill.GradientVariant
Case Is = msoGradientPresetColors
.Background.Fill.PresetGradient _
SrcSld.Background.Fill.GradientStyle, _
SrcSld.Background.Fill.GradientVariant, _
SrcSld.Background.Fill.PresetGradientType
Case Is = msoGradientOneColor
.Background.Fill.OneColorGradient _
SrcSld.Background.Fill.GradientStyle, _
SrcSld.Background.Fill.GradientVariant, _
SrcSld.Background.Fill.GradientDegree
End Select
Case Is = msoFillBackground
' Only shapes - we shouldn't come here
End Select
End If
' >>>>>>>>>>>>>>>>>>>>
End With
Next Idx
End Sub
Le code ne vérifie pas en lecture seule ou mot de passe fies protégés et plantera sur eux. Il faut aussi veiller à ne pas courir le fichier collecteur lui-même. Sinon, il devrait fonctionner. Je dois admettre que je ne l'ai pas revu le code depuis longtemps; -)
Autres conseils
Vous pouvez google "powerpoint join" pour trouver un outil utile pour rejoindre de nombreux ppts.
A simple and fast solution:
I := Presentation.Slides.InsertFromFile(FileName,X,StartSlideNo,EndSlideNo);
Presentation.Slides.Item(I).ApplyTheme(FileName);
Presentation.Slides.Item(I).ApplyTemplate(FileName);
Note: X is place to insert slide in presentation
I is actual place where slide was inserted
Code is written in Delphi/Pascal but you can convert it easelly ...