您的位置：首页 > 编程语言 > VB

Use VBA to update PPT from Excel

2016-06-23 15:52 519 查看

This is a journal recording my process of learning VBA to update PPT from Excel sheet. MS Office version: 2016.

The first two things:

1. open VBA by alt+F11 in an opened office program.

2.[ If control Excel in PowerPoint] In "Tool"->"References" choose MS Excel 16.0 Object library (otherwise will have error "object not found")

[ If control PowerPoint in Excel] In "Tool"->"References" choose MS PowerPoint 16.0 Object library

3. My first design was pull data from Excel to PowerPoint. One difficulty is how to find shape names. Then I found a video "https://www.youtube.com/watch?v=WcxHgo8k6CA" which introduces
another structure: use one excel sheet as a buffer area (Sheet 1) between PowerPoint and Excel. First we pull data one by one from PowerPoint shapes to sheet 1. Thus we have a list of shapes we need to update and we know their slides, names and current value.
Second, we update data in excel and push those data pack to their PowerPoint positions.

4. The code in the video

<pre class="lang-vb prettyprint prettyprinted" style="margin-top: 0px; margin-bottom: 1em; padding: 5px; border: 0px; font-size: 13px; width: auto; max-height: 600px; overflow: auto; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; color: rgb(57, 51, 24); word-wrap: normal; background-color: rgb(239, 240, 241);"><code style="margin: 0px; padding: 0px; border: 0px; font-family: Consolas, Menlo, Monaco, "Lucida Console", "Liberation Mono", "DejaVu Sans Mono", "Bitstream Vera Sans Mono", "Courier New", monospace, sans-serif; white-space: inherit;">Dim ppapp As PowerPoint.Application
Dim pppres As PowerPoint.Presentation

Sub getshapedata()
On Error GoTo line1
Set ppapp = GetObject(, "Powerpoint.application")
Set pppres = ppapp.ActivePresentation

Dim shapeslide
Dim shapename
Dim shapetext
Dim nextrow

shapeslide = ppapp.ActiveWindow.View.Slide.SlideIndex
shapename = ppapp.ActiveWindow.Selection.ShapeRange(1).Name
shapetext = pppres.Slides(shapeslide).Shapes(shapename).TextEffect.Text
friendlyname = InputBox("Insert Friendly Name for " & shapetext, "Friendly Name", "")

nextrow = Sheet1.Range("a" & Rows.Count).End(xlUp).Row + 1

Sheet1.Range("a" & nextrow) = shapeslide
Sheet1.Range("b" & nextrow) = shapename
Sheet1.Range("c" & nextrow) = shapetext
Sheet1.Range("d" & nextrow) = friendlyname

Exit Sub

line1:
MsgBox "No item selected"

End Sub

Sub writedata()
Dim c As Object
Dim shapeslide
Dim shapename
Dim shapetext

Set ppapp = GetObject(, "Powerpoint.application")
Set pppres = ppapp.ActivePresentation

For Each c In Sheet1.Range("a2:a" & Sheet1.Range("a" & Rows.Count).End(xlUp).Row)

shapeslide = Sheet1.Range("a" & c.Row)
shapename = Sheet1.Range("b" & c.Row)
shapetext = Sheet1.Range("c" & c.Row).Text
friendlyname = Sheet1.Range("d" & c.Row)
pppres.Slides(shapeslide).Shapes(shapename).TextEffect.Text = shapetext

Next c

End Sub</code>

6/23 : currently the selection part is not working well

内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理

标签： vba excel PPT

相关文章推荐

新的分享

章节导航