簡體   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