From VBA in Excel, Copy charts and Ranges and Paste-special into PowerPoint and Word

Hi Tim,

There are a few questions there, how about we tackle the PowerPoint ones first. This code assumed that a reference to the PowerPoint object has been set

The first code should work with a link - my powerpoint doesn't display the charts or pictures as I have some sort of problem but there is a linked chart object there

Sub exp()
    Dim ppApp As PowerPoint.Application, ppSlide As PowerPoint.Slide
    Set ppApp = New PowerPoint.Application

    With ppApp
        .Visible = True
        .Presentations.Add
        .ActiveWindow.ViewType = ppViewSlide
        Set ppSlide = .ActivePresentation.Slides.Add(1, ppLayoutBlank)
    End With
   
    ActiveSheet.ChartObjects(1).Select
    ActiveChart.ChartArea.Copy
    ppSlide.Shapes.PasteSpecial(link:=True).Select
   
End Sub

For your range copy request

    ActiveSheet.Range("a1:c3").Copy

and then either

    ppSlide.Shapes.PasteSpecial(ppPasteDefault, link:=True).Select
    ppSlide.Shapes.PasteSpecial(ppPasteHTML, link:=True).Select

remove the link:=True portion if you dont want the link

Cheers

Dave

Dave,

Thanks!  Basically this code works great.

One issue:
I need to paste a range as an unlinked picture into ppt so that the numbers cannot be changed.

The statement :     ppSlide.Shapes.PasteSpecial(ppPasteDefault, link:=False).Select     pastes the range in ppt with editable numbers and it behaves like it is HTML.  This so even if I omit   ",  link:=False".

What is the command to copy a range and paste as an unlinked picture in ppt?s


The rest of the original question is: what is the code to copy and paste charts and ranges into WORD with all the options we have discussed above?  Basically the same code as above, just modified for pasting into Word.

Thanks in advance.

Tim

Dave,

Can you modify your code to where it copies and pastes directly into a currently open PowerPoint file?  My application is to paste charts and ranges into an existing ppt onto the currently active slide.

I've tried to modify your code, put its not working for me.

Tim

Hi Tim,

I still can't get my PP or Word to take images from an Excel file, so I'm posting these comments with code untested

Have you tried pasting  the range as a picture type, ie maybe

ppSlide.Shapes.PasteSpecial (ppPasteBitmap)

you may want to try preceding that with
ActiveSheet.Range("a1:c3").CopyPicture

As for automtaing Word and checking for an existing instance you could try this code assuming that you have set a reference to the Word Object. Again, the last line is unfortunately untested

Sub ExpWW()
    Dim wApp As Word.Application

    On Error Resume Next
    Set wApp = GetObject(, "Word.Application")
    On Error GoTo 0

    If wApp Is Nothing Then Set wApp = New Word.Application
    If wApp.Documents.Count = 0 Then wApp.Documents.Add
       
    wApp.Visible = True

    ActiveSheet.ChartObjects(1).Copy
    wApp.Selection.PasteAndFormat wdChart

End Sub

Cheers

Dave

Dave,
I really appreciate the help even though you are handicapped by not being able to test the code.  And I think we are very close to having this figured out.
 
I slightly modified your subroutine as shown below.  I added line numbers to the code to aid our discussion.

As you wrote it, it  opens a new instance of PowerPoint, pastes the range with a link, and centers the object on the slide.  From that perspective it works great.

I am trying to modify the code so that it does not open a new ppt file, it just pastes into an already open and active ppt file.  

I am having no luck.  No matter how I try to modify the code, above line 12, to prevent a new ppt file from being created, it always gets an error at line 12.  It seems that this code only works if a new instance of ppt is opened.  How can it be changed?

Sub pptRangePasteSpecialLink()
   
1       Dim ppApp As PowerPoint.Application
2       Dim ppSlide As PowerPoint.Slide
3       Set ppApp = New PowerPoint.Application

4       With ppApp
5             .Visible = True
6             .Presentations.Add
7             .ActiveWindow.ViewType = ppViewSlide
8             Set ppSlide = .ActivePresentation.Slides.Add(1, ppLayoutBlank)
9       End With
10     Worksheets("Sheet1").Activate
11     ActiveSheet.Range("A3:G10").Copy
12     ppSlide.Shapes.PasteSpecial(ppPasteDefault, link:=True).Select
   
           'Center pasted object in the slide
13        ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
14        ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

End Sub



Also,

The following routine below also works great for simply pasting an unlinked chart into an already opened ppt file, and this is the routine that I am using for this purpose.

The problem I have is that I don't know all the correct copy and paste commmands for this routine to:
Copy chart and paste link into ppt.
Copy a range and paste link into ppt.
Copy a range and paste picture unlinked
Copy a range and paste HTML unlinked

If you know how to make the following routine copy and paste as I described, then my problem is over.

Sub pptChartPastePicture()
   
    Dim ppApp As Object

    Set ppApp = CreateObject("PowerPoint.Application")    'create PowerPoint application object
    ppApp.ActiveWindow.ViewType = ppViewSlide

    Worksheets("Sheet1").Activate
    ActiveSheet.ChartObjects(1).Select
    ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _
        Format:=xlPicture

    ppApp.ActiveWindow.View.Paste

        'Center pasted object in the slide
        ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
        ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
   
End Sub


Dave,

So with either routine, we are very close to having it figured out.  If you could modify the first routine to not open a new ppt instance, or provide the right copy and paste commands for the second routine, the problem is solved.

 I greatly appreciate your assistance.

Thank you,
Tim

Hi Tim,

I should have expanded more on my Word example as that shows how to check for an open instance. Hopefully this helps

Cheers

Dave


Sub ExpPP()
    Dim ppApp As PowerPoint.Application, ppSlide As PowerPoint.Slide

    'Look for existing instance
    On Error Resume Next
    Set ppApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0

    'Create new instance if no instance exists
    If ppApp Is Nothing Then Set ppApp = New PowerPoint.Application
    'Add a presentation if none exists
    If ppApp.Presentations.Count = 0 Then ppApp.Presentations.Add
    'Make the isntance visible
    ppApp.Visible = True

    'Check that a slide exits, if it doesn't add 1 slide. Else use the last slide for the paste operation
    If ppApp.ActivePresentation.Slides.Count = 0 Then
        Set ppSlide = ppApp.ActivePresentation.Slides.Add(1, ppLayoutBlank)
    Else
        Set ppSlide = ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count)
    End If

    'Ranges
    Worksheets(1).Range("A3:G10").Copy
    'Range linked
    ppSlide.Shapes.PasteSpecial(ppPasteDefault, Link:=True).Select
    'Range as HTML
    ppSlide.Shapes.PasteSpecial(ppPasteHTML).Select
    'Range as HTML linked
    ppSlide.Shapes.PasteSpecial(ppPasteHTML, Link:=True).Select

   'Charts
    Worksheets(1).ChartObjects(1).Select
    ActiveChart.ChartArea.Copy
    'Chart Linked
    ppSlide.Shapes.PasteSpecial(Link:=True).Select
    'Chart Not Linked
    ppSlide.Shapes.PasteSpecial(Link:=False).Select

    'Center pasted object in the slide
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

End Sub

Dave,

I made a few changes to the routine to get it to run and a few enhancements.
1. It now adds a slide to the end of the presentation and pastes on that new last slide.
2. I figured out how to paste a range as an unlinked picture and that option is now included
3. Excel kept erroring on the lines:
   'Charts
    Worksheets(1).ChartObjects(1).Select
    ActiveChart.ChartArea.Copy

For some reason, it just didn't like it, so I had to break it up as shown below to get it to work.

4. The following code does not paste a picture of the chart.  It doesn't paste anything at all.
            'Chart Not Linked
            ppSlide.Shapes.PasteSpecial(Link:=False).Select

   But these line do work:
            'Copy & Paste Chart Not Linked
            ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
            ppSlide.Shapes.Paste.Select

  The parameters after CopyPicture are necessary to keep the chart from being the size of the slide.

 
Here is the latest.

Sub ExpPP()
    Dim ppApp As PowerPoint.Application, ppSlide As PowerPoint.Slide

    'Look for existing instance
    On Error Resume Next
    Set ppApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0

    'Create new instance if no instance exists
    If ppApp Is Nothing Then Set ppApp = New PowerPoint.Application
    'Add a presentation if none exists
    If ppApp.Presentations.Count = 0 Then ppApp.Presentations.Add
    'Make the isntance visible
    ppApp.Visible = True

    'Check that a slide exits, if it doesn't add 1 slide. Else use the last slide for the paste operation
    If ppApp.ActivePresentation.Slides.Count = 0 Then
        Set ppSlide = ppApp.ActivePresentation.Slides.Add(1, ppLayoutBlank)
    Else
        ppApp.ActivePresentation.Slides.Add ppApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank
        ppApp.ActiveWindow.View.GotoSlide ppApp.ActivePresentation.Slides.Count
        Set ppSlide = ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count)
    End If

    'Options for Copy & Paste Ranges and Charts.  Pick one
   
        'Options for Copy & Paste Ranges
        Worksheets("PowerPoint").Range("B3:G9").Copy
            'Paste Range linked
            ppSlide.Shapes.PasteSpecial(ppPasteDefault, Link:=True).Select
        '    'Paste Range as HTML
            ppSlide.Shapes.PasteSpecial(ppPasteHTML).Select
        '    'Paste Range as HTML linked
            ppSlide.Shapes.PasteSpecial(ppPasteHTML, Link:=True).Select
       
        'Copy & Paste Range as Picture unlinked
        Worksheets("PowerPoint").Range("B3:G9").CopyPicture
            ppSlide.Shapes.Paste.Select
   
   
       'Options for Copy and Paste Charts
        Worksheets("PowerPoint").Activate 'ChartObjects(1).Select
        ActiveSheet.ChartObjects(1).Select
   
            'Copy & Paste Chart Linked
            ActiveChart.ChartArea.Copy
            ppSlide.Shapes.PasteSpecial(Link:=True).Select
       
            'Copy & Paste Chart Not Linked
            ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
            ppSlide.Shapes.Paste.Select

    'Center pasted object in the slide
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

End Sub


Dave,

The above routine now works beautifully as is .  It is very fast and clean.  All my required copy & paste options are available and functioning.


Two last questions before I close out this out:

1. I need the option of pasting onto the currently visible slide of a currently open ppt file. The user may be working in a ppt file and just simply need to paste into the slide he is currently working on.
 
  The  code:
     Set ppSlide = ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count)
  Sets to the last slide in the presentation.

  What is the command to Set ppSlide to the currently visible slide in a previously opened ppt file?
 
 
2. Would you like to earn another 500 points by converting this routine to paste into a Word document?  If so, say yes and I will post another question for your benefit.

Thanks a million Dave, great work!

Tim

Tim,

(1) try
Set ppSlide = ppApp.ActiveWindow.View.Slide

(2) I'm more than happy to try it - assuming no one else beats me to it

I enjoyed this one, and at last I can see it working on my work pc

Cheers

Dave

Dave,

Thanks a bunch.

Below is my final routine for copying and pasting charts and ranges into PowerPoint.  It works flawlessly!

If no ppt is opened, it opens one.
If a ppt is currently active, it pastes into it.
It can paste on the currently active slide or append slides to the end and paste.
It can paste charts linked or unlinked
It can paste ranges as a picture linked or unlinked or as HTML linked or unlinked.

Very cool subroutine!  This is the subroutine that I want converted to paste into Word.  The Word version needs to behave the same way this one does. Now you have a head start.

I will post the following question right now for you to look for:

   
        How to Convert Excel Copy & Paste to PPT routine to Paste into Word.


I will not close this current question until I know that you have found the new question.  That way you won't get lost.  This is a good routine to keep handy.

Thanks Dave
What an awesome job!



----------Final Routine-------------
Variable names:
    Dim SheetName As String
   
    Dim PasteChart As Variant
    Dim PasteChartLink As Variant
    Dim ChartNumber As Integer
   
    Dim PasteRange As Variant
    Dim RangePasteType As Variant
    Dim RangeName As String
    Dim AddSlidesToEnd As Variant


Sub Copy_Paste_to_PowerPoint()
   
    'Passed parameters
        'SheetName           - name of sheet in Excel that contains the range or chart to copy
        '
        'PasteChart            -If = True then routine will  copy and paste a chart
        'PasteChartLink      -If = True then Routine will paste chart with Link; if = False then paste chart no link
        'ChartNumber        -Chart Object Number
        '
        'PasteRange          -If = True then Routine will copy and Paste a range
        'RangePasteType   -Paste as Picture linked or unlinked, HTML Linked or unlinked. See routine below for exact values
        'RangeName          -Name of range to copy; "B3:G9", etc.
        'AddSlidesToEnd    -If = True then appednd slides to end of presentation and paste.  If False then paste on current slide.

   
    Dim ppApp As PowerPoint.Application, ppSlide As PowerPoint.Slide

    'Look for existing instance
    On Error Resume Next
    Set ppApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0

    'Create new instance if no instance exists
    If ppApp Is Nothing Then Set ppApp = New PowerPoint.Application
    'Add a presentation if none exists
    If ppApp.Presentations.Count = 0 Then ppApp.Presentations.Add
    'Make the isntance visible
    ppApp.Visible = True

    'Check that a slide exits, if it doesn't add 1 slide. Else use the last slide for the paste operation
    If ppApp.ActivePresentation.Slides.Count = 0 Then
        Set ppSlide = ppApp.ActivePresentation.Slides.Add(1, ppLayoutBlank)
   
    Else
        If AddSlidesToEnd = True Then
            'Appends slides to end of presentation and makes last slide active
            ppApp.ActivePresentation.Slides.Add ppApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank
            ppApp.ActiveWindow.View.GotoSlide ppApp.ActivePresentation.Slides.Count
            Set ppSlide = ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count)
        ElseIf AddSlidesToEnd = False Then
            'Sets current slide to active slide
            Set ppSlide = ppApp.ActiveWindow.View.Slide
        End If
    End If

    'Options for Copy & Paste Ranges and Charts
   
    If PasteRange = True Then
        'Options for Copy & Paste Ranges
        If RangePasteType = "Picture - Linked" Then
            'Paste Range linked
            Worksheets(SheetName).Range(RangeName).Copy
            ppSlide.Shapes.PasteSpecial(ppPasteDefault, Link:=True).Select
       
        ElseIf RangePasteType = "HTML    - Unlinked" Then
        '    'Paste Range as HTML
            Worksheets(SheetName).Range(RangeName).Copy
            ppSlide.Shapes.PasteSpecial(ppPasteHTML).Select
           
        ElseIf RangePasteType = "HTML    - Linked" Then
            'Paste Range as HTML linked
            Worksheets(SheetName).Range(RangeName).Copy
            ppSlide.Shapes.PasteSpecial(ppPasteHTML, Link:=True).Select
       
        ElseIf RangePasteType = "Picture - Unlinked" Then
            'Copy & Paste Range as Picture unlinked
            Worksheets(SheetName).Range(RangeName).CopyPicture
            ppSlide.Shapes.Paste.Select
        End If
    End If
   
   
    If PasteChart = True Then
       'Options for Copy and Paste Charts
        Worksheets(SheetName).Activate
        ActiveSheet.ChartObjects(ChartNumber).Select
   
        If PasteChartLink = True Then
            'Copy & Paste Chart Linked
            ActiveChart.ChartArea.Copy
            ppSlide.Shapes.PasteSpecial(Link:=True).Select
        End If
        If PasteChartLink = False Then
            'Copy & Paste Chart Not Linked
            ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
            ppSlide.Shapes.Paste.Select
        End If
    End If
   
    'Center pasted object in the slide
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

End Sub

Keep at it.  We will figure it out.

See you on the next question.

Tim

Code written up with some error testing improvements at http://www.vbaexpress.com/kb/getarticle.php?kb_id=370

Credits to Jon Peltier and Tim.

Cheers

Dave

Thanks Dave
Tim