使用 excel 宏创建幻灯片

Question

我有一个有趣的问题我不确定。我没有使用过 power point，也没有什么 excel 宏观经验。我发现了许多与我类似的问题，但其中 none 个非常符合要求。我正在通过筹款活动帮助我当地的慈善机构，并且需要一种方法来制作 triva 类游戏。游戏将以powerpoint展示，所有问题、选择、答案都在一个excelsheet中。它的排列方式是每行一个问题，列为：问题、选项、答案和类别。

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

示例行（| 表示列）：

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

因此结果将是标题为 "Which of these was an italian sculptor?" 且内容为 a) Michelangelo、b) tintoretto、c) da vinci、d) galilleo

下面的幻灯片只是 "Michelangelo"

Answer 1

我有一个商业 PPT 插件可以执行 type 的事情，但不幸的是不是 exact 的事情。

大体上，您希望从包含两张幻灯片的 PPT 演示文稿开始，每张幻灯片都有 "placeholder" 个文本框...包含 @question@、@answer@ 和很快。

代码将：

计算数据行数（即需要的问答幻灯片对数）

复制您的起始 "template" PPT 文件，然后将每张原始幻灯片复制 n 次，其中 n=电子表格中数据的行数。

向下遍历数据行，对于每一行，替换当前幻灯片中的@question@文本，替换当前幻灯片中的选项，递增幻灯片计数器，将当前幻灯片中的@answer@替换为来自当前行数据的答案等等。

你可以写成PPT或者Excel；如果你熟悉 VBA/Excel，我会在那里做。

Answer 2

我设法在 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

使用 excel 宏创建幻灯片

Create power point using excel macro

excel

powerpoint

vba