Question

我需要能够在原始.ppt中的所选幻灯片中创建新的.ppt（PowerPoint演示文稿）。以下宏将采用您当前选择的任何幻灯片，并将其复制到新的.ppt。我找到了以下很好的代码来完成大部分工作。

Private Sub NytPPT_Click()

'PURPOSE: Copies selected slides and pastes them into a brand new presentation file
'SOURCE: www.TheSpreadsheetGuru.com

Dim NewPPT As Presentation
Dim OldPPT As Presentation
Dim Selected_slds As SlideRange
Dim Old_sld As Slide
Dim New_sld As Slide
Dim x As Long, y As Long
Dim myArray() As Long
Dim SortTest As Boolean

'Set variable to Active Presentation
  Set OldPPT = ActivePresentation

'Set variable equal to only selected slides in Active Presentation
  Set Selected_slds = ActiveWindow.Selection.SlideRange

'Sort Selected slides via SlideIndex
  'Fill an array with SlideIndex numbers
    ReDim myArray(1 To Selected_slds.Count)
      For y = LBound(myArray) To UBound(myArray)
        myArray(y) = Selected_slds(y).SlideIndex
      Next y

  'Sort SlideIndex array
    Do
      SortTest = False
      For y = LBound(myArray) To UBound(myArray) - 1
        If myArray(y) > myArray(y + 1) Then
          Swap = myArray(y)
          myArray(y) = myArray(y + 1)
          myArray(y + 1) = Swap
          SortTest = True
        End If
      Next y
    Loop Until Not SortTest

'Set variable equal to only selected slides in Active Presentation (in numerical order)
  Set Selected_slds = OldPPT.Slides.Range(myArray)

'Create a brand new PowerPoint presentation
  Set NewPPT = Presentations.Add

'Align Page Setup
  NewPPT.PageSetup.SlideHeight = OldPPT.PageSetup.SlideHeight
  NewPPT.PageSetup.SlideOrientation = OldPPT.PageSetup.SlideOrientation
  NewPPT.PageSetup.SlideSize = OldPPT.PageSetup.SlideSize
  NewPPT.PageSetup.SlideWidth = OldPPT.PageSetup.SlideWidth

'Loop through slides in SlideRange
  For x = 1 To Selected_slds.Count

    'Set variable to a specific slide
      Set Old_sld = Selected_slds(x)

    'Copy Old Slide
      yy = Old_sld.SlideIndex
      Old_sld.Copy

    'Paste Slide in new PowerPoint
      NewPPT.Slides.Paste
      Set New_sld = Application.ActiveWindow.View.Slide

    'Bring over slides design
      New_sld.Design = Old_sld.Design

    'Bring over slides custom color formatting
      New_sld.ColorScheme = Old_sld.ColorScheme

    'Bring over whether or not slide follows Master Slide Layout (True/False)
      New_sld.FollowMasterBackground = Old_sld.FollowMasterBackground

  Next x


End Sub

我需要做的是根据复选框选择要复制的幻灯片。因此，例如，如果我选择Check Box 1 = TRUE，它将创建幻灯片1,2和3.或者如果我选择复选框2 = TRUE，它可以选择幻灯片3,4,5和6.所以，如果我选择了两个框，它将创建幻灯片= 1,2,3,4,5,6。留出任何重复。

我已经尝试了很多，包括：

Private Sub CheckBox1_Click()
    If CheckBox1.Value = True Then
        ActivePresentation.Slides.Range(Array(1, 2, 3)).Select
    Else
        MsgBox "nothing"
    End If
End Sub


Private Sub CheckBox2_Click()
    If CheckBox2.Value = True Then
        ActivePresentation.Slides.Range(Array(3, 4, 5, 6)).Select
    Else
        MsgBox "nothing"
    End If
End Sub

我收到错误：幻灯片（未知成员）：请求无效。此视图不支持选择。

我不确定如何才能让它发挥作用？感谢任何帮助，我对VBA编码很新。

代码的所有功劳归于。 http://www.thespreadsheetguru.com/the-code-vault/2014/4/3/copy-selected-slides-into-new-powerpoint-presentation

Answer 1

您可以切换视图以启用要选择的幻灯片，如下所示：

ActiveWindow.ViewType = ppViewSlideSorter

出于某种原因，幻灯片未在普通视图中选择！

但是在PowerPoint中选择内容带来了自己的挑战（如视图类型所示），您无需根据此示例选择它们来复制和粘贴它们：

With ActivePresentation.Slides
  .Range(Array(1, 2)).Copy
  .Paste
End With

这将简化您的代码，因为您不需要管理窗口及其视图。

通过Power Point VBA中的复选框选择某些幻灯片

1 个答案: