Chart to PPT from linked sheets

[J@@]

Hello
Beginning in VBA, I followed Mark Ivey's idea and took a look at the excellent
Jon Peltier's site:

"Paste Each Embedded Chart in the Active Worksheet into a New Slide in the
Active Presentation, using the Chart Title as the Slide Title"
http://peltiertech.com/Excel/XL_PPT.html#chartstitlesslides

Q1 : I tried to modify this code so that I could paste the charts from many
selected sheets, but I only obtain the charts from the first selected sheet
pasted as many times as sheets are selected.

Q2 : The titles pasted in Powerpoint appear very large, in point 44, how could
I, with this same macro, reduce it in 24??

Here is Jon's code and the lines I added :

'********
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

Dim wks As Worksheet '<===******added

' Reference existing instance of PowerPoint
Set PPApp = GetObject(, "Powerpoint.Application")
' Reference active presentation
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = ppViewSlide

For Each wks In ActiveWorkbook.Windows(1).SelectedSheets '<===******added

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
.CopyPicture _
Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture

' 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.Paste.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
Next '<===******added
' Clean up
Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing

End Sub
'********

Thanks to all for the help

Jean F

 

[J@@]

Hello
Everything's fine now
I added activesheet.select
and
activesheet.next.select
and for the formatting :
.Shapes.Placeholders(1).TextFrame.TextRange.Font.Size = 24
.Shapes.Placeholders(1).TextFrame.TextRange.Paragraphs(Start:=1,
Length:=1).ParagraphFormat.Alignment = ppAlignCenter

Thanks
J@@

 

[Jon Peltier]

For the first piece, you could also try:

For Each wks In ActiveWorkbook.Windows(1).SelectedSheets
' change ActiveSheet to wks
For iCht = 1 To wks.ChartObjects.Count
With wks.ChartObjects(iCht).Chart


- Jon

 

[J@@]

Thank you Jon for the help.

Your site is a goldmine

Cordially
J@@