使用 Excel VBA 在 PowerPoint 中添加自定义幻灯片布局？答案

【问题标题】：Add a custom slide layout in PowerPoint using Excel VBA?使用 Excel VBA 在 PowerPoint 中添加自定义幻灯片布局？
【发布时间】：2017-04-20 23:13:14
【问题描述】：

我创建了一个带有自定义幻灯片布局的 PowerPoint。我希望能够使用 Excel VBA 使用这些自定义布局之一创建新幻灯片，但我无法找出正确的语法。

这是我目前拥有的代码：

Sub runPPT()

Application.ScreenUpdating = False

Dim wb As Workbook
Set wb = ThisWorkbook

Dim ws As Worksheet
Set ws = wb.Sheets("SG2")

Dim pptName As String
Dim ppt As Object
Dim myPres As Object
Dim slds As Object
Dim sld As Object

MsgBox ("Please choose PowerPoint to open.")
pptName = openDialog()
Set ppt = CreateObject("PowerPoint.Application")
Set myPres = ppt.Presentations.Open(pptName)

Set slds = myPres.Slides
'This is where I want to add my custom layout
'My layouts all have similar names like "Gate 2 Main" if that helps
Set sld = slds.AddSlides(Slides.Count + 1, ActivePresentation.SlideMaster.CustomLayouts(1))

Application.ScreenUpdating = True
End Sub


Private Function openDialog()
Dim fd As Office.FileDialog
Dim txtFileName As String
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
  .AllowMultiSelect = False
  ' Set the title of the dialog box.
  .Title = "Please select the file."

  ' Clear out the current filters, and add our own.
  .Filters.Clear

  ' Show the dialog box. If the .Show method returns True, the
  ' user picked at least one file. If the .Show method returns
  ' False, the user clicked Cancel.
  If .Show = True Then

    txtFileName = .SelectedItems(1) 'replace txtFileName with your textbox

  End If

End With

openDialog = txtFileName

End Function

【问题讨论】：

请解释您当前代码中的确切问题。

标签： vba excel powerpoint

【解决方案1】：

我能够通过将代码更改为以下内容来解决我的问题：

Sub runPPT()

   Application.ScreenUpdating = False

   Dim wb As Workbook
   Set wb = ThisWorkbook

   Dim ws As Worksheet
   Set ws = wb.Sheets("SG2")

   Dim pptName As String
   Dim ppt As PowerPoint.Application
   Dim myPres As PowerPoint.Presentation
   Dim slds As PowerPoint.Slides
   Dim sld As PowerPoint.slide

   Dim oLayout As CustomLayout

   MsgBox ("Please choose PowerPoint to open.")
   pptName = openDialog()
   Set ppt = CreateObject("PowerPoint.Application")
   Set myPres = ppt.Presentations.Open(pptName)

   Set slds = myPres.Slides
   Set sld = slds.Add(myPres.Slides.Count + 1, ppLayoutBlank)

   For Each oLayout In myPres.Designs("Gate Main").SlideMaster.CustomLayouts
       If oLayout.Name = "Gate 2 Main" Then
           sld.CustomLayout = oLayout
           Exit For
       End If
   Next

   Application.ScreenUpdating = True

End Sub


Private Function openDialog()

   Dim fd As Office.FileDialog

   Dim txtFileName As String

   Set fd = Application.FileDialog(msoFileDialogFilePicker)

   With fd

     .AllowMultiSelect = False

     ' Set the title of the dialog box.
     .Title = "Please select the file."

     ' Clear out the current filters, and add our own.
     .Filters.Clear

     ' Show the dialog box. If the .Show method returns True, the
     ' user picked at least one file. If the .Show method returns
     ' False, the user clicked Cancel.
     If .Show = True Then

       txtFileName = .SelectedItems(1) 'replace txtFileName with your textbox

     End If

  End With

  openDialog = txtFileName

End Function

【讨论】：