Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

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

Posted on 2009-05-07
2
Medium Priority
?
1,207 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
  • 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

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

In this post we will learn how to make Android Gesture Tutorial and give different functionality whenever a user Touch or Scroll android screen.
This article will show how Aten was able to supply easy management and control for Artear's video walls and wide range display configurations of their newsroom.
This video teaches viewers how to create handouts from their slides and helps them decide how many slides to include per handout.
Six Sigma Control Plans

926 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