View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Yurble Yurble is offline
external usenet poster
 
Posts: 9
Default Excel Chart macro to paste into Powerpoint

Finally success in modifying the code to paste link

Now, just wonder, is there anyway to export all workbook, instead of
each worksheet...


Sub ChartsAndTitlesToPresentation()
' Set a VBE reference to Microsoft PowerPoint Object Library

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim PresentationFileName As Variant
Dim SlideCount As Long
Dim iCht As Integer
Dim sTitle As String

' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")


' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide

For iCht = 1 To ActiveSheet.ChartObjects.Count
With ActiveSheet.ChartObjects(iCht).Chart

' get chart title
If .HasTitle Then
sTitle = .ChartTitle.Text
Else
sTitle = ""
End If

' remove title (or it will be redundant)
.HasTitle = False

' copy chart as a picture
.ChartArea.Copy

' restore title
If Len(sTitle) 0 Then
.HasTitle = True
.ChartTitle.Text = sTitle
End If
End With

' Add a new slide and paste in the chart
SlideCount = PPPres.Slides.Count
Set PPSlide = PPPres.Slides.Add(SlideCount + 1, ppLayoutTitleOnly)
PPApp.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
With PPSlide
' paste and select the chart picture
.Shapes.PasteSpecial(Link:=True).Select
' align the chart
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters,
True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles,
True
.Shapes.Placeholders(1).TextFrame.TextRange.Text = sTitle
End With

Next

' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End Sub