Программно объединить слайды из нескольких презентаций в одну презентацию

StackOverflow https://stackoverflow.com/questions/5316459

Вопрос

Мне нужно автоматизировать создание презентации (либо OpenOffice, либо PowerPoint). Презентация должна взять первые два слайда каждой из презентаций в данном каталоге, а затем объединить их в одну презентацию. Я не понимаю, какой подход я должен использовать, чтобы решить это. Любые указатели будут оценены.

Это было полезно?

Решение

Говоря о PowerPoint, вы бы использовали макрос VBA, чтобы выполнять работу, что -то вроде

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

Выбор вашего исходного каталога вы можете использовать эту функцию

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

Теперь - главное - вставлять слайды из другого PPT, пока Сохранение формата источника. Анкет Это сложно, как PPT VBA InsertFromFile Метод не имеет хорошего использования. Microsoft дала нам хорошее время, чтобы выяснить это трудный путь в бесчисленных 20 -часовых сессиях отладки :-), и вам нужно напечатать много кода, чтобы сделать это правильно - гораздо сложнее, чем использование диалога вручную, в частности, если ваш источник слайд. отклоняется от вашего источника мастер -слайда.

Если ваши PPT придерживаются своих мастеров, вы можете безопасно опустить весь код между ">>>>"

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

Код не проверяется на наличие только для чтения или пароля Fies и будет сбой на них. Также будьте осторожны, чтобы не запустить сам файл коллекционера. В противном случае это должно работать. Я должен признать, что давно не просмотрел код ;-)

Другие советы

Вы можете Google "PowerPoint Join", чтобы найти полезный инструмент для присоединения многих PPT.

Я рада @miked смог получить вам то, что вам нужно.

Другой метод, который следует рассмотреть, если использование .NET обсуждается в эта почта

Простое и быстрое решение:

I := Presentation.Slides.InsertFromFile(FileName,X,StartSlideNo,EndSlideNo);
Presentation.Slides.Item(I).ApplyTheme(FileName);
Presentation.Slides.Item(I).ApplyTemplate(FileName);

Примечание: x - это место для вставки слайда в презентацию

Я фактическое место, где был вставлен слайд

Код написан в Delphi/Pascal, но вы можете преобразовать его воспитательница ...

Лицензировано под: CC-BY-SA с атрибуция
Не связан с StackOverflow
scroll top