Combinar programáticamente las diapositivas de múltiples presentaciones en una sola presentación
-
24-10-2019 - |
Pregunta
Necesito automatizar la creación de una presentación (ya sea OpenOffice o PowerPoint). La presentación debe tomar las dos primeras diapositivas de cada una de las presentaciones en un directorio determinado, y luego combinarlos en una sola presentación. Estoy confundido sobre qué enfoque debería tomar para resolver esto. Cualquier consejo será apreciado.
Solución
Hablando de PowerPoint, usarías una macro de VBA para hacer el trabajo, algo como
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
Seleccionar su directorio de origen puede usar esta función
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
Ahora, el punto principal es insertar diapositivas de otro PPT mientras Preservar el formato de origen. Esto es algo complicado, como el PPT VBA InsertFromFile
El método no es de buen uso. Microsoft nos dio un buen momento para resolverlo de la manera difícil en innumerables sesiones de depuración de 20 horas :-) y debe escribir mucho código para hacerlo correctamente, mucho más complicado que usar el diálogo manualmente, en particular si su fuente pasa se desvía de su diapositiva maestra de origen.
Si sus PPT se apegan a sus maestros, puede omitir de manera segura todo el código entre el ">>>>"
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
El código no verifica los Fies de solo lectura o protegidos con contraseña y se bloqueará en ellos. También tenga cuidado de no ejecutarse sobre el archivo de recopilación en sí. De lo contrario debería funcionar. Debo admitir que no he revisado el código durante mucho tiempo ;-)
Otros consejos
Puede Google "PowerPoint Join" para encontrar una herramienta útil para unirse a muchos PPT.
Me alegro @miked Pude conseguirte lo que necesitabas.
Otro método a considerar, si usa .net, se discute en esta publicación
Una solución simple y rápida:
I := Presentation.Slides.InsertFromFile(FileName,X,StartSlideNo,EndSlideNo);
Presentation.Slides.Item(I).ApplyTheme(FileName);
Presentation.Slides.Item(I).ApplyTemplate(FileName);
Nota: X es lugar para insertar diapositivas en la presentación
Yo es un lugar real donde se insertó la diapositiva
El código está escrito en Delphi/Pascal, pero puede convertirlo en Easlelly ...