以編程方式將來自多個演示文稿的幻燈片合併爲一個演示文稿

Question

我需要自動創建演示文稿（OpenOffice或Powerpoint）。演示文稿應該將每個演示文稿的前兩張幻燈片放在一個給定的目錄中，然後將它們合併成一個演示文稿。我很困惑我應該採取什麼辦法來解決這個問題。任何指針將不勝感激。

Answer 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方法沒有好用。微軟給了我們很好的時間在無數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 

的代碼不檢查只讀或密碼保護外商投資企業和意志撞上他們。另外請注意不要運行收集器文件本身。否則它應該工作。我必須承認，我很久沒有審查代碼;-)

Answer 2

您可以谷歌「powerpoint加入」找到一個有用的工具來加入許多ppts。

Answer 3

我很高興@miked能夠得到你所需要的。

如果使用.NET，還需要考慮另一種方法，請參閱this post