vba - 使用 excel 宏创建 power point

Question

我有一个我不确定的有趣问题。我没有使用过 power point，也没有什么 excel 宏观经验。我发现了许多与我类似的问题，但没有一个完全符合要求。我正在通过筹款事件帮助我本地的慈善机构，并且需要一种方法来制作一种琐碎的游戏。游戏会以PPT形式展示，所有的问题、选择和答案都在Excel表格中。它的放置方式是每行一个问题，列是:问题、选项、答案和类别。

我已经很容易管理类别排序，但现在我需要以某种方式创建 power point 幻灯片，以便问题是标题，选项是内容，然后下面的幻灯片是答案那个问题。因此，每个问题都会创建两张幻灯片，一张问答幻灯片。

示例行(| 表示列):

Which of these was an italian sculptor? | Michelangelo, tintoretto, da vinci, galilleo | michelangelo | Art

所以结果将是标题为“其中哪一位是意大利雕塑家？”的一面。和内容 a) 米开朗基罗 b) 丁托列托 c) 达芬奇 d) 伽利略

下面的幻灯片只是“米开朗基罗”

Answer 1

我设法在excel宏中自己编写代码。这不是最好的解决方案，但它很容易遵循并且可以由遇到相同问题的人修改。仅供引用，我是这个问题的提问者，但我的电脑非常需要重新镜像，我无法登录堆栈溢出......哦。这是我解决此问题的代码。请注意，所有问题之前都是按类别排序的，所以我只是更改了开始和结束循环控制变量以在保存和关闭先前创建的 ppts 后创建新的 ppts。以下代码可能包含从其他堆栈溢出问题中借用的代码并被重新利用:

Sub CreatePowerPointQuestions()

 'Add a reference to the Microsoft PowerPoint Library by:
'1. Go to Tools in the VBA menu
'2. Click on Reference
'3. Scroll down to Microsoft PowerPoint X.0 Object Library, check the box, and press Okay

'First we declare the variables we will be using
    Dim newPowerPoint As PowerPoint.Application
    Dim activeSlide As PowerPoint.Slide
    Dim Question As String
    Dim Options As String 'comma separated list of options
    Dim Choices() As String 'split up options for printing
    Dim printOptions As String 'string to print in contents of slide
    Dim Answer As String
    Dim limit As Integer
'set question amount:
    limit = 5
 'Look for existing instance
    On Error Resume Next
    Set newPowerPoint = GetObject(, "PowerPoint.Application")
    On Error GoTo 0

'Let's create a new PowerPoint
    If newPowerPoint Is Nothing Then
        Set newPowerPoint = New PowerPoint.Application
    End If
'Make a presentation in PowerPoint
    If newPowerPoint.Presentations.Count = 0 Then
        newPowerPoint.Presentations.Add
    End If

'Show the PowerPoint
    newPowerPoint.Visible = True
'Select worksheet and cells activate
    Worksheets("Sheet1").Activate

'Loop through each question
    For i = 1 To limit

    'Add a new slide where we will paste the Question and Options:
        newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
        newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
        Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)

    'Set the variables to the cells
        Question = ActiveSheet.Cells(i, 1).Value
        Options = ActiveSheet.Cells(i, 2).Value
        Answer = ActiveSheet.Cells(i, 3).Value

    'Split options into choices a,b,c,d based on comma separation
        Choices() = Split(Options, ", ")
    'Formate printOptions to paste into content
        printOptions = "A) " & Choices(0) & vbNewLine & "B) " & Choices(1) & vbNewLine & "C) " & Choices(2) & vbNewLine & "D) " & Choices(3)
        activeSlide.Shapes(2).TextFrame.TextRange.Text = printOptions

    'Set the title of the slide the same as the question for the options
        activeSlide.Shapes(1).TextFrame.TextRange.Text = Question

    'Add answer slide and select it
        newPowerPoint.ActivePresentation.Slides.Add newPowerPoint.ActivePresentation.Slides.Count + 1, ppLayoutText
        newPowerPoint.ActiveWindow.View.GotoSlide newPowerPoint.ActivePresentation.Slides.Count
        Set activeSlide = newPowerPoint.ActivePresentation.Slides(newPowerPoint.ActivePresentation.Slides.Count)
    'Set title:
        activeSlide.Shapes(1).TextFrame.TextRange.Text = "Answer:"
    'Set contents to answer:
        activeSlide.Shapes(2).TextFrame.TextRange.Text = Answer
    'Finished with a row (question)
    Next

AppActivate ("Microsoft PowerPoint")
Set activeSlide = Nothing
Set newPowerPoint = Nothing

End Sub