copy embedded charts of the active worksheet as picture into PowerPoint aligning them

Dear Experts:

This procedure ....
... copies each embedded chart of the active worksheet as a picture,
... then pastes it onto the second slide in the active PowerPoint presentation.

This code works just fine, but with the disadvantage that ...
... all of the charts get centered on the slide one above the other.

I would like to tweak it so that the following requirements are met:

1. The charts should be scaled down to 80% of their original size
2. There are always only 4 charts to be exported to the second slide. Their names in Excel are:
MyChart_01, MyChart_02, MyChart_03, MyChart_04
The Position of MyChart01 on the second slide (vertically 2 cm from the top margin and horizontally 1 cm from the left margin
The Position of MyChart02 on the second slide: (vertically 10 cm from the top margin and horizontally 1 cm from the left margin)
The Position of MyChart03 on the second slide (vertically 2 cm from the top margin and horizontally 12 cm from the left margin
The Position of MyChart04 on the second slide: (vertically 10 cm from the top margin and horizontally 12 cm from the left margin)
3. Charts that are already on the second slide of the active ppt-presentation have to be deleted first.

Help is very much appreciated. Thank you very much in advance.

Regards, Andreas


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

'Paste Each Embedded Chart in the Active Worksheet into the second slide in the Active Presentation
'This procedure copies each embedded chart in the active worksheet as a picture from an Excel worksheet,
'then pastes it into the second slide of the active presentation



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 ReturnValue As Integer

On Error GoTo ErrorHandling

ReturnValue = MsgBox("Would you like to export all the charts of the active worksheet as PICTURE into the second slide of the ACTIVE PPT ?", vbYesNoCancel, "Exporting charts to Active PPT")


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

For iCht = 1 To ActiveSheet.ChartObjects.Count
    ' copy chart as a picture
    ActiveSheet.ChartObjects(iCht).Chart.CopyPicture _
        Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
    
    Set PPSlide = PPPres.Slides(2)
   
    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
        
   
                
    End With

Next

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


Exit Sub

ErrorHandling:

If Err.number = 429 Then
MsgBox "The macro cannot find an open ppt presentation in which to export the graphics!" & vbCr & vbCr & _
"Please open either ..." & vbCr & _
"... (1) your ppt-presentation in which you would like the graphics to be inserted" & vbCr & _
"... (2) or just open a blank ppt-file, add a slide and activate the second slide", vbInformation, "No ppt-file found"
ElseIf Err.number = -2147188160 Then
MsgBox "The macro cannot find an open ppt presentation in which to export the graphics!" & vbCr & vbCr & _
"PowerPoint has been started but no file is open!", vbCritical, "No ppt-file found"
Else
MsgBox "The following error has occurred " & Err.number
End If

End Sub

Open in new window

Andreas HermleTeam leaderAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Jamie GarrochPowerPoint Consultant & DeveloperCommented:
Try this Andreas:

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

'Paste Each Embedded Chart in the Active Worksheet into the second slide in the Active Presentation
'This procedure copies each embedded chart in the active worksheet as a picture from an Excel worksheet,
'then pastes it into the second slide of the active presentation



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 ReturnValue As Integer

On Error GoTo ErrorHandling

ReturnValue = MsgBox("Would you like to export all the charts of the active worksheet as PICTURE into the second slide of the ACTIVE PPT ?", vbYesNoCancel, "Exporting charts to Active PPT")


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

For iCht = 1 To ActiveSheet.ChartObjects.Count
    ' copy chart as a picture
    ActiveSheet.ChartObjects(iCht).Chart.CopyPicture _
        Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
    
    Set PPSlide = PPPres.Slides(2)
   
    With PPSlide
        ' paste and select the chart picture
      Dim oShp As Shape
      Set oShp = .Shapes.Paste(1)
      With oShp
        ' Scale shape
        .Width = .Width * 0.8: .Height = .Height * 0.8
        Select Case icht
          ' Position = Xcm / 2.54 inches to per cm * 72DPI
          Case 1: .Top = 2 / 2.54 * 72: .Left = 1 / 2.54 * 72
          Case 2: .Top = 10 / 2.54 * 72: .Left = 1 / 2.54 * 72
          Case 3: .Top = 2 / 2.54 * 72: .Left = 12 / 2.54 * 72
          Case 4: .Top = 10 / 2.54 * 72: .Left = 12 / 2.54 * 72
        End Select
      End With
    End With

Next

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


Exit Sub

ErrorHandling:

If Err.number = 429 Then
MsgBox "The macro cannot find an open ppt presentation in which to export the graphics!" & vbCr & vbCr & _
"Please open either ..." & vbCr & _
"... (1) your ppt-presentation in which you would like the graphics to be inserted" & vbCr & _
"... (2) or just open a blank ppt-file, add a slide and activate the second slide", vbInformation, "No ppt-file found"
ElseIf Err.number = -2147188160 Then
MsgBox "The macro cannot find an open ppt presentation in which to export the graphics!" & vbCr & vbCr & _
"PowerPoint has been started but no file is open!", vbCritical, "No ppt-file found"
Else
MsgBox "The following error has occurred " & Err.number
End If

End Sub

Open in new window

0
Rgonzo1971Commented:
Hi,

pls try

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

'Paste Each Embedded Chart in the Active Worksheet into the second slide in the Active Presentation
'This procedure copies each embedded chart in the active worksheet as a picture from an Excel worksheet,
'then pastes it into the second slide of the active presentation



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 ReturnValue As Integer

On Error GoTo ErrorHandling

ReturnValue = MsgBox("Would you like to export all the charts of the active worksheet as PICTURE into the second slide of the ACTIVE PPT ?", vbYesNoCancel, "Exporting charts to Active PPT")


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

Set PPSlide = PPPres.Slides(2)
 
For Idx = PPSlide.Shapes.Count To 1 Step -1
    Set shp = PPSlide.Shapes(Idx)
    If shp.Name Like "Picture*" Then
        shp.Delete
    End If
Next
For iCht = 1 To ActiveSheet.ChartObjects.Count
    ' copy chart as a picture
    ActiveSheet.ChartObjects(iCht).Chart.CopyPicture _
        Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
    

    With PPSlide

        .Shapes.Paste.Select
        ' align the chart
        Set shp = PPApp.ActiveWindow.Selection.ShapeRange

        Select Case iCht
            Case 1
                shp.Top = Application.CentimetersToPoints(2)
                shp.Left = Application.CentimetersToPoints(1)
            Case 2
                shp.Top = Application.CentimetersToPoints(10)
                shp.Left = Application.CentimetersToPoints(1)
            Case 3
                shp.Top = Application.CentimetersToPoints(2)
                shp.Left = Application.CentimetersToPoints(12)
            Case 4
                shp.Top = Application.CentimetersToPoints(10)
                shp.Left = Application.CentimetersToPoints(12)
        End Select
        shp.ScaleHeight 0.8, msoTrue, msoScaleFromMiddle
        
    End With

Next

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


Exit Sub

ErrorHandling:

If Err.Number = 429 Then
MsgBox "The macro cannot find an open ppt presentation in which to export the graphics!" & vbCr & vbCr & _
"Please open either ..." & vbCr & _
"... (1) your ppt-presentation in which you would like the graphics to be inserted" & vbCr & _
"... (2) or just open a blank ppt-file, add a slide and activate the second slide", vbInformation, "No ppt-file found"
ElseIf Err.Number = -2147188160 Then
MsgBox "The macro cannot find an open ppt presentation in which to export the graphics!" & vbCr & vbCr & _
"PowerPoint has been started but no file is open!", vbCritical, "No ppt-file found"
Else
MsgBox "The following error has occurred " & Err.Number
End If

End Sub

Open in new window

Regards
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Andreas HermleTeam leaderAuthor Commented:
works like a charm, as always. Thank you very much for your great, professional and swift help.

Regards, Andreas
0
Andreas HermleTeam leaderAuthor Commented:
Hi Jamie,

thank you very much for your swift help. Your code regrettably throws a 13 error code, therefore I awarded the points fully to Rgonzo. His solution works just great.

Nevertheless thank you very much for your great effort and help. I really appreciate it.

Regards, Andreas
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.