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

时间:2015-07-07 17:00:10

标签: excel vba excel-vba powerpoint powerpoint-vba

我试图编写一些VBA代码从excel电子表格中取出2个单元格并将它们放在标题中,并在开头添加一些文本。任何人都可以帮我做这件事。只是为了一些帮助,如果我不够清楚我想要powerpoint上的标题基本上是:

"(细胞A1的内容)(细胞A2的内容)&#34的响应;

我知道必须有办法做到这一点,但这是我第一次尝试使用VBA创建一些东西,而且我发现它有点困难。

2 个答案:

答案 0 :(得分:1)

根据您的问题,这是VBA代码:

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  

您必须添加Microsoft PowerPoint 12.0对象库引用才能使用此代码。

答案 1 :(得分:0)

尝试这样可以让你朝着正确的方向前进:

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
相关问题