View Single Post
 
Old 12-04-2012, 12:24 AM
macropod's Avatar
macropod macropod is offline Windows 7 64bit Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,938
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

Hi george,

Try something based on the following Excel macro:
Code:
Sub Excel2PwrPt()
' Requires a reference to Microsoft PowerPoint Object Library
Application.ScreenUpdating = False
Dim StrPath As String, LRow As Long, i As Long, x As Long
StrPath = "C:\Users\George\Documents\"
Dim PwrPt As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSld As PowerPoint.Slide
Dim pptLayout As PowerPoint.CustomLayout
' Create an instance of PowerPoint
Set PwrPt = New PowerPoint.Application
PwrPt.Visible = True
' Open the presentation
Set pptPres = PwrPt.Presentations.Open(Filename:=StrPath & "Presentation1.ppt")
x = pptPres.Slides.Count
' Reference active slide
Set pptSld = pptPres.Slides(x)
With Worksheets("Sheet1")
  LRow = .Range("A65536").End(xlUp).Row
  For i = 1 To LRow
    pptPres.Slides.Add Index:=x + i, Layout:=ppLayoutTitleOnly
    ' Insert the Excel Cell's value from Column A into the slide title
    pptPres.Slides(x + i).Shapes(1).TextFrame.TextRange.Text = .Cells(i, 1).Value
    ' Insert the picture referenced in Column B
    pptPres.Slides(x + i).Shapes.AddPicture Filename:=StrPath & .Cells(i, 2).Value, _
     LinkToFile:=False, Top:=100, Left:=150, Width:=400, SaveWithDocument:=True
  Next i
End With
' Clean up
Set pptSld = Nothing: Set pptPres = Nothing: Set PwrPt = Nothing
Application.ScreenUpdating = True
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote