繁体   English   中英

使用excel宏创建电源点

[英]Create power point using excel macro

我有一个我不确定的有趣问题。 我没有使用power point并且没有很好的宏观经验。 我发现了很多与我相似的问题,但它们都不符合要求。 我正在用筹款活动帮助我当地的慈善机构,并且需要一种方法来制作一种triva游戏。 游戏将与powerpoint一起显示,所有问题,选择和答案都在excel表中。 我们的方式是每行一个问题,列是:问题,选项,答案和类别。

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

示例行(|表示列):

其中哪一个是意大利雕塑家? | Michelangelo,tintoretto,da vinci,galilleo | 米开朗基罗| 艺术

因此,结果将是标题为“其中哪一个是意大利雕塑家?”的一面。 和内容a)Michelangelo,b)tintoretto,c)da vinci,d)galilleo

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

我设法在excel宏中自己编写代码。 这不是最好的解决方案,但它很容易遵循,并且可以由具有相同问题的人修改。 仅供参考我是这个问题的提问者,但我的计算机非常需要重新映像,我无法登录堆栈溢出......好吧。 这是我的代码解决了这个问题。 请注意,所有问题都是按类别排序的,所以我只是更改了开始和结束循环控制变量,以便在保存和关闭先前创建的变量后创建新的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

我有一个商业PPT插件,做这种类型的事情,但遗憾的是没有这个确切的事情。

概括地说,你想要开始一个PPT演示文稿,其中有两张幻灯片,每张幻灯片都有“占位符”文本框......文本框中包含@ question @,@ answer @等文本。

代码将:

获取数据行数(即需要的Q&A幻灯片对的数量)

复制您的起始“模板”PPT文件,然后复制每个原始幻灯片n次,其中n =电子表格中的数据行数。

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

你可以用PPT或Excel写这个; 如果你熟悉VBA / Excel,我会在那里做。

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM