Solved

Pasting a de-linked COPY of Charts from Excel into Powerpoint

Posted on 2009-05-07
2
1,202 Views
Last Modified: 2013-11-10
I have writted the Subroutine below which walks through a list and copies slides based on a Spreadsheet into a Powerpoint Presentation.  The problem is this:
 
Even though I've selected msoFalse for Linked in the PastSpecial command, the chart images are still linked and when the spreadsheet charts change, the pasted images in the Powerpoint Presentation also change, so I end up with 17 slides all with the same 4 images on them.

How do I break the linkage when I paste the image so that it actually pastes the image and delinks it immediately from the source image (so that when I change the source image, the pasted image doesn't change)
Sub MakePicQuads(ByVal ControlID As IRibbonControl)
    'This macro will copy all Charts to a PowerPoint Presentation
    'Each chart will become part of a 'quad' slide
    
    Dim myPPT As New PowerPoint.Application
    Dim myPres As PowerPoint.Presentation
    Dim PPSlide As PowerPoint.Slide
    Dim thisChart As Chart
    Dim thisShape As Shape
    Dim thisSheet As Worksheet
    Dim quadCount As Integer
        
    myPPT.Visible = True
    
    Set myPres = myPPT.Presentations.Add(msoTrue)
    myPPT.ActiveWindow.ViewType = ppViewSlide
    quadCount = 0
                  
    For Each thisSheet In Application.ActiveWorkbook.Worksheets
    For Each thisShape In thisSheet.Shapes
        ' copy chart
        If thisShape.Type = msoChart Then
            Set thisChart = thisShape.Chart
            thisChart.CopyPicture
          
            If quadCount = 0 Then
        
            ' Add a new slide
                SlideCount = myPres.Slides.Count
                Set PPSlide = myPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
                myPPT.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
            End If
        
            ' paste and select the chart
            'PPSlide.Shapes.PasteSpecial(ppPasteOLEObject, , , , , msoFalse).Select
            PPSlide.Shapes.PasteSpecial ppPasteEnhancedMetafile, , , , , msoFalse
                            
            'Set the size and location depending on which slide it is.
            myPPT.ActiveWindow.Selection.ShapeRange.Height = 180
            myPPT.ActiveWindow.Selection.ShapeRange.Width = 325
            myPPT.ActiveWindow.Selection.ShapeRange.Top = IIf(quadCount > 1, 300, 100)
            myPPT.ActiveWindow.Selection.ShapeRange.Left = IIf(quadCount Mod 2 = 0, 30, 370)
            
            quadCount = quadCount + 1
            If quadCount > 3 Then
                quadCount = 0
            End If
        End If
    Next
    Next
 
End Sub

Open in new window

0
Comment
Question by:rgautier
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
2 Comments
 
LVL 13

Author Comment

by:rgautier
ID: 24324774
Edit: I pasted the wrong code above...here's the one I'm working on
Sub TheList()
    'This macro will copy all Charts to a PowerPoint Presentation
    'Each chart will become part of a 'quad' slide
    
    Dim myPPT As New PowerPoint.Application
    Dim myPres As PowerPoint.Presentation
    Dim PPSlide As PowerPoint.Slide
    Dim thisChart As Chart
    Dim thisShape As Shape
    Dim thisSheet As Worksheet
    Dim quadCount As Integer
        
    myPPT.Visible = True
    
    Set myPres = myPPT.Presentations.Add(msoTrue)
    myPPT.ActiveWindow.ViewType = ppViewSlide
    quadCount = 0
    Dim myRow As ListRow
    For Each myRow In ActiveSheet.ListObjects("TheListofMDs").ListRows
        ActiveSheet.PivotTables("PivotTable1").PivotFields("design").ClearAllFilters
        ActiveSheet.PivotTables("PivotTable1").PivotFields("design").CurrentPage = myRow.Range(, 1).Value
    For Each thisSheet In Application.ActiveWorkbook.Worksheets
    For Each thisShape In thisSheet.Shapes
        ' copy chart
        If thisShape.Type = msoChart Then
            Set thisChart = thisShape.Chart
            thisChart.ChartArea.Copy
          
            If quadCount = 0 Then
        
            ' Add a new slide
                SlideCount = myPres.Slides.Count
                Set PPSlide = myPres.Slides.Add(SlideCount + 1, ppLayoutBlank)
                myPPT.ActiveWindow.View.GotoSlide PPSlide.SlideIndex
            End If
        
            ' paste and select the chart
            'PPSlide.Shapes.PasteSpecial(ppPasteOLEObject, , , , , msoFalse).Select
            PPSlide.Shapes.Paste.Select
                            
            'Set the size and location depending on which slide it is.
            myPPT.ActiveWindow.Selection.ShapeRange.Height = 180
            myPPT.ActiveWindow.Selection.ShapeRange.Width = 325
            myPPT.ActiveWindow.Selection.ShapeRange.Top = IIf(quadCount > 1, 300, 100)
            myPPT.ActiveWindow.Selection.ShapeRange.Left = IIf(quadCount Mod 2 = 0, 30, 370)
            
            quadCount = quadCount + 1
            If quadCount > 3 Then
                quadCount = 0
            End If
        End If
    Next
    Next
    Next
 
End Sub

Open in new window

0
 
LVL 13

Accepted Solution

by:
rgautier earned 0 total points
ID: 24324810
And....that explains everything - I have been editing the wrong function - never mind.
0

Featured Post

PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
In this post we will learn how to connect and configure Android Device (Smartphone etc.) with Android Studio. After that we will run a simple Hello World Program.
The viewer will learn how to edit text. This includes Font, Spacing, Resizing, Color, and other special text options.

738 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question