プログラムで複数のプレゼンテーションからスライドを単一のプレゼンテーションに結合する

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

質問

プレゼンテーション(OpenOfficeまたはPowerPoint)の作成を自動化する必要があります。プレゼンテーションでは、特定のディレクトリの各プレゼンテーションの最初の2つのスライドを取得し、それらを1つのプレゼンテーションに結合する必要があります。私はこれを解決するためにどのようなアプローチをとるべきかについて混乱しています。どんなポインターも感謝します。

役に立ちましたか?

解決

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

コードは、読み取り専用またはパスワードで保護されたFIEをチェックせず、クラッシュします。また、コレクターファイル自体を実行しないように注意してください。それ以外の場合は機能するはずです。私は長い間コードをレビューしていないことを認めなければなりません;-)

他のヒント

「PowerPoint Join」をGoogleで検索して、多くの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で書かれていますが、Easellyを変換できます...

ライセンス: CC-BY-SA帰属
所属していません StackOverflow
scroll top