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

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

我需要做的是根据复选框选择要复制的幻灯片。因此，例如，如果我选择复选框 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

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