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....tstitlesslides

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

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

Thanks
J@@

J@@ wrote:
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....tstitlesslides

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

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
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
http://PeltierTech.com
_______


"J@@" wrote in message
...
Hello
Everything's fine now
I added activesheet.select
and
activesheet.next.select
and for the formatting :
.Shapes.Placeholders(1).TextFrame.TextRange.Font.S ize = 24

.Shapes.Placeholders(1).TextFrame.TextRange.Paragr aphs(Start:=1,
Length:=1).ParagraphFormat.Alignment = ppAlignCenter

Thanks
J@@

J@@ wrote:
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....tstitlesslides

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

Thank you Jon for the help.

Your site is a goldmine :-)

Cordially
J@@

Jon Peltier wrote:
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
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
http://PeltierTech.com
_______


"J@@" wrote in message
...
Hello
Everything's fine now
I added activesheet.select
and
activesheet.next.select
and for the formatting :
.Shapes.Placeholders(1).TextFrame.TextRange.Font.S ize = 24

.Shapes.Placeholders(1).TextFrame.TextRange.Paragr aphs(Start:=1,
Length:=1).ParagraphFormat.Alignment = ppAlignCenter

Thanks
J@@

J@@ wrote:
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....tstitlesslides

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