Conversion of excel chart into PPT slide using macro

dhananjaywalke

Board Regular
Joined
Jun 26, 2006
Messages
60
Hi all

I am currently using one macro to copy excel charts & paste them into the PPT slide. I am using enhanced meta format to copy the chart into the slide but now the file size is big.

Can you please help to reduce the file size may be by changing the macro or changing the copy paste format. I dont know what to do?

See the macro below for your reference

Code:
Sub PPGenerate()

'Requires a reference to the Microsoft PowerPoint Library via the Tools - Reference menu in the VBE

Dim ppApp As PowerPoint.Application
Dim ppSlide As PowerPoint.Slide
     
'Part of code sourced from Jon Peltier [url]http://peltiertech.com/Excel/XL_PPT.html[/url]
     
Dim SheetName As String
Dim AddSlidesToEnd As Boolean
Dim i, h As Integer
Dim cel, loc, fil As String

i = 71
Set ppApp = New PowerPoint.Application
If ppApp.Presentations.Count = 0 Then ppApp.Presentations.Add
AddSlidesToEnd = True
Do Until i = 93
cel = "Reference!A" & i
loc = Excel.Range(cel).Value
Excel.Range("Control!B7").Value = loc
Sheets("Month").Select

SheetName = ActiveSheet.Name
    
    'Make the instance 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
        
             '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)

    End If
     

         'Options for Copy and Paste Charts
        Sheets(SheetName).Activate
        ActiveChart.ChartArea.Select
        Call chartscale

        ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        'ppSlide.Shapes.Paste.Select
        ppSlide.Shapes.PasteSpecial(ppPasteEnhancedMetafile).Select
 
     
     'Center pasted object in the slide
    ppApp.ActiveWindow.Selection.ShapeRange.Width = 700
     
     
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

    ppApp.ActivePresentation.PrintOptions.OutputType = ppPrintOutputFourSlideHandouts
    ppApp.ActivePresentation.PageSetup.SlideOrientation = msoOrientationHorizontal
    ppApp.ActivePresentation.PageSetup.NotesOrientation = msoOrientationHorizontal
     
     
    AppActivate ("Microsoft PowerPoint")
    Set ppSlide = Nothing
     
i = i + 1
Loop

Sheets("KNA").Select
Sheets("KNA").Activate

    
    'Make the instance 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
        
             '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)

    End If
     

         'Options for Copy and Paste Charts
        Sheets("KNA").Activate
        ActiveChart.ChartArea.Select

        ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        ppSlide.Shapes.Paste.Select


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

    ppApp.ActivePresentation.PrintOptions.OutputType = ppPrintOutputFourSlideHandouts
    ppApp.ActivePresentation.PageSetup.SlideOrientation = msoOrientationHorizontal
    ppApp.ActivePresentation.PageSetup.NotesOrientation = msoOrientationHorizontal
     
     
    AppActivate ("Microsoft PowerPoint")
    Set ppSlide = Nothing
    
Sheets("AS").Select
Sheets("AS").Activate

    
    'Make the instance 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
        
             '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)

    End If
     

         'Options for Copy and Paste Charts
        Sheets("AS").Activate
        ActiveChart.ChartArea.Select

        ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        ppSlide.Shapes.Paste.Select


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

    ppApp.ActivePresentation.PrintOptions.OutputType = ppPrintOutputFourSlideHandouts
    ppApp.ActivePresentation.PageSetup.SlideOrientation = msoOrientationHorizontal
    ppApp.ActivePresentation.PageSetup.NotesOrientation = msoOrientationHorizontal
     
     
    AppActivate ("Microsoft PowerPoint")
    Set ppSlide = Nothing
    
    
Sheets("AP").Select
Sheets("AP").Activate

    
    'Make the instance 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
        
             '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)

    End If
     

         'Options for Copy and Paste Charts
        Sheets("AP").Activate
        ActiveChart.ChartArea.Select

        ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
        ppSlide.Shapes.Paste.Select


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

    ppApp.ActivePresentation.PrintOptions.OutputType = ppPrintOutputFourSlideHandouts
    ppApp.ActivePresentation.PageSetup.SlideOrientation = msoOrientationHorizontal
    ppApp.ActivePresentation.PageSetup.NotesOrientation = msoOrientationHorizontal
     
     
    AppActivate ("Microsoft PowerPoint")
    Set ppSlide = Nothing
On Error GoTo exi
    
ppApp.ActivePresentation.SaveAs Filename
exi:
Err.Clear

ppApp.Quit

End Sub
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.

sweater_vests_rock

Well-known Member
Joined
Oct 8, 2004
Messages
1,657
dh.

could you compress the pics in PPT using the compress pictures option on the Picture toolbar?

ben.
 

dhananjaywalke

Board Regular
Joined
Jun 26, 2006
Messages
60
Compress Picture didnot work.


I need something else to help me out in this issue.

Any ways sweater_vests_rock thanks for that value addition
 

kcchiefsae

New Member
Joined
Jan 8, 2008
Messages
6
Does anyone know how to clear an already existing slide before pasting the chart from excel?

Thanks,

KC
 

Forum statistics

Threads
1,136,354
Messages
5,675,296
Members
419,559
Latest member
BraytonM

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top