Excel VBA:如何通过 PowerPoint VBA 创建 Word 讲义?

Excel VBA:如何通过 PowerPoint VBA 创建 Word 讲义?

抱歉,如果标题令人困惑。我正在尝试执行一个多应用程序子程序,最终将通过电子邮件发送 PDF 附件。该过程首先从 CSV 中提取信息(我已经这样做了),然后使用该信息填充 PowerPoint 中预先存在的幻灯片(也这样做了)。下一步是我无法弄清楚的。可以通过 PowerPoint 创建讲义,但我只知道如何设置对话框,而不知道如何完成该过程。

PowerPointApp.CommandBars.ExecuteMso ("CreateHandoutsInWord") 将打开对话框,但仅此而已。我已经成功使用 SendKeys 执行了其余操作,但在移交给 Word 时总是失败。在代码中放入 Waits 也无济于事。我现在正在研究一种替代方法,但很好奇是否有人知道如何完成这个过程。

  Sub CreateHandoutsForWord()

    Dim mailSht As Worksheet
    Dim PowerPointApp As Object
    Dim myPresentation As Object
    Dim sl As Object
    Dim myShape As Object

    Dim impStr As String
    Dim implStr() As String
    Dim wordPath As String

    Dim fso As New FileSystemObject
    Dim fo As Folder
    Dim f As File

    Dim wordApp As New Word.Application
    Dim wordDoc As Word.Document

    Set mailSht = Worksheets("Mailer")

    impStr = OpenCSV
    implStr() = Split(impStr, " ")

    Set fo = fso.GetFolder(mailSht.Range("E5").Value)

    Set f = fo.Files("Mailer.pptx")

    On Error Resume Next

      Set PowerPointApp = GetObject(Class:="PowerPoint.Application")

      Err.Clear

      If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(Class:="PowerPoint.Application")

      If Err.Number = 429 Then
        MsgBox "PowerPoint could not be found, aborting."
        Exit Sub
      End If

  On Error GoTo 0


     Application.ScreenUpdating = False

    'Create a New Presentation

    Set myPresentation = PowerPointApp.Presentations.Open(f.Path)

    Set sl = myPresentation.Slides(1)
    sl.Shapes.Range(Array(2, 1)).Item(1).TextFrame.TextRange.Text = "Scott Corwin"
    sl.Shapes.Range(Array(3, 1)).Item(1).TextFrame.TextRange.Text = "Guest Speaker"

    PowerPointApp.CommandBars.ExecuteMso ("CreateHandoutsInWord")

    Application.Wait Now + 0.00003
    PowerPointApp.Activate
    SendKeys "{DOWN}", True

    Application.Wait Now + 0.00001
    PowerPointApp.Activate
    SendKeys "{DOWN}", True

     Application.Wait Now + 0.00001
     PowerPointApp.Activate
     SendKeys "~", True

     Application.Wait Now + 0.0003
     PowerPointApp.Activate
     myPresentation.Close
     PowerPointApp.Quit

     Application.Wait Now + 0.0006
      Set wordApp = GetObject(Class:="Word.Application")

此时,应用程序会停止运行,并反复显示应用程序不可用的错误。一旦我弄清楚了这一点,我就会拥有可以创建 PDF 并通过 Outlook 发送电子邮件的工作代码。

相关内容