如何使用Excel电子表格中的2个单元格在PowerPoint幻灯片上创建标题

Question

I'm trying to write some VBA code to take 2 cells from an excel spreadsheet and put them both in a title with some text at the beginning. Can anyone help me going about doing this. Just for a bit of help in case I wasn't clear enough I'm wanting the title on the powerpoint to basically be:

"Response from (Contents of Cell A1) of (Contents of Cell A2)"

I know there must be a way to do this but this is my first time trying to create something with VBA and I'm finding it a bit difficult.

Answer 1

Based on your question, here is VBA code:

strFirst = (Contents of Cell A1)    'your code to read the value of A1
strScond = (Contents of Cell A2)    'your code to read the value of A2

strTitle = "Response from " & strFirst & " of " & strScond

Set pp = CreateObject("PowerPoint.Application")
Set PPPres = pp.Presentations.Add
pp.Visible = True
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutTitle)
'Some code to play with main (1st) slide

Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutChart)  'ppLayoutChart would be depending upon your content/ your choice
PPSlide.Select
PPSlide.Shapes(1).Select
Set myTitle = PPSlide.Shapes.Title
myTitle.TextFrame.TextRange.Characters.Text = strTitle

pp.ActivePresentation.SaveAs ("some path")
pp.ActivePresentation.Close
pp.Quit  

You have to add Microsoft PowerPoint 12.0 Object Library reference in order to use this code.

Answer 2

Try this to get you going in the right direction:

Option Explicit

#Const EARLYBINDING = False

' ===========================================================================================
' Copy Specific cells to a Title shape in PowerPoint.
' Written by : Jamie Garroch of YOUpresent Ltd. (UK)
' Date : 07 JULY 2015
' For more amazing PowerPoint stuff visit us at from http://youpresent.co.uk/
' ===========================================================================================
' Copyright (c) 2015 YOUpresent Ltd.
' Source code is provide under Creative Commons Attribution License
' This means you must give credit for our original creation in the following form:
' "Includes code created by YOUpresent Ltd. (YOUpresent.co.uk)"
' Commons Deed @ http://creativecommons.org/licenses/by/3.0/
' License Legal @ http://creativecommons.org/licenses/by/3.0/legalcode
' ===========================================================================================
' Macro Execution Environment : Designed to run in Excel VBA.
' ===========================================================================================
' You can use Early Binding (with the advantage that IntelliSense adds) by adding a reference
' to the PowerPoint Object Library and setting the compiler constant EARLYBINDING to True
' but delete it afterwards otherwise you will face a nightmare of compatibility!!!
' ===========================================================================================
Public Sub CopyCellsToPowerPoint()
#If EARLYBINDING Then
  ' Define Early Binding PowerPoint objects so you can use IntelliSense while debuggging
  ' Requires a reference (Tools/References) to the Microsoft PowerPoint XX.Y Object Library
  Dim oPPT As PowerPoint.Application
  Dim oPres As PowerPoint.Presentation
  Dim oSld As PowerPoint.Slide
  Dim oShp As PowerPoint.Shape
#Else
  ' Define Late Binding PowerPoint objects
  ' Remove the reference to the Microsoft PowerPoint Object Library
  Dim oPPT As Object
  Dim oPres As Object
  Dim oSld As Object
  Dim oShp As Object
  Const ppLayoutTitle = 1
#End If
  ' Define Excel objects
  Dim oWB As Workbook
  Dim oWS As Worksheet
  ' Define other variables
  Dim sText As String

  ' Create an instance of PowerPoint
  Set oPPT = CreateObject("PowerPoint.Application")
  ' Create a new Presentation
  Set oPres = oPPT.Presentations.Add(WithWindow:=msoTrue)
  ' Insert a slide using the title layout
  Set oSld = oPres.Slides.Add(1, ppLayoutTitle)

  ' Set a reference to the Excel workbook and sheet
  Set oWB = Workbooks(1)
  Set oWS = oWB.Worksheets(1)

  ' Create the title text from the A1 and A2 cells in the worksheet
  sText = "Response from " & oWS.Cells(1, 1) & " of " & oWS.Cells(2, 1)
  oSld.Shapes.Title.TextFrame.TextRange.Text = sText

  ' Clear objects
  Set oPPT = Nothing
  Set oPres = Nothing
  Set oSld = Nothing
  Set oShp = Nothing
  Set oWB = Nothing
  Set oWS = Nothing
End Sub