Excel Tables To Powerpoint Charts

[Draperies]

I am having incredible difficulty designing a macro to take tables I have in excel and adding each table on a new slide as a clustered column chart in powerpoint (from a blank powerpoint template file). Further, I cannot at all figure out how to do this so that the data is in powerpoint and not linked to the excel sheet.

The tables in excel are simple tables and separated by a row. I would want to go through each table and give it its own slide in powerpoint.

Any help on this would be greatly appreciated, thanks!

 

[ChrisM]

I have a function in my add-in that pastes the highlighted Excel range (or chart) into the current Powerpoint slide as an enhanced metafile. You should be able to use this directly, or modify to your needs.

Couple notes:

1) You don't have to "Copy" anything in Excel, just click a chart once to select it, or highlight a range of cells.

2) The macro autosizes the chart to best fit my company's internal PPT template. It puts the chart about an inch down from the top left corner, then expands the chart to best fit the full page.

3) PPT must be open to a blank slide

4) The sub takes a parameter or 1 or 4. Use 1 to make a full size chart, or 4 to make 4 smaller charts that are sized to all fit on one slide

Sub ExportPPTRoutine(PicSize As Integer)
'export selected range to an open PPT slide, as a metafile
'Picsize 1 = full size, 4 = 4up

Dim PPApp As Object 'PowerPoint.Application
Dim PPPres As Object 'PowerPoint.Presentation
Dim PPSlide As Object 'PowerPoint.Slide
Dim PicCount As Long
Dim xSize As Double
Dim ySize As Double

' Make sure a range or chart is selected
If TypeName(Selection) <> "Range" And TypeName(Selection) <> "ChartArea" Then
    MsgBox "Please select a worksheet range/chart and try again.", vbExclamation, _
        "No Range/Chart Selected"
Else
    ' Reference instance of PowerPoint
    On Error Resume Next
    ' Check whether PowerPoint is running
    Set PPApp = GetObject(, "PowerPoint.Application")
    If PPApp Is Nothing Then ' PowerPoint is not running, notify and cancel
        MsgBox "No Powerpoint session open. Please open a PPT file first."
        Exit Sub
    End If
    On Error GoTo 0

    ' Reference active presentation
    Set PPPres = PPApp.ActivePresentation
    PPApp.ActiveWindow.ViewType = 1 'ppViewSlide
    ' Reference active slide
    Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection.SlideRange.SlideIndex)

    ' Copy and Pastespecial the range
    Selection.Copy
    'PPSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile, _
        Link:=msoFalse
    PPSlide.Shapes.PasteSpecial DataType:=2, _
        Link:=0

    ' Align the pasted range
    PicCount = PPApp.ActiveWindow.Selection.SlideRange.Shapes.Count
    With PPApp.ActiveWindow.Selection.SlideRange.Shapes(PicCount)
        .Select
        .LockAspectRatio = 0 'msoFalse
        .Top = 78
        .Left = 12
        
        Select Case PicSize
            Case 1 'full size
                xSize = 690 / .Width
                ySize = 408 / .Height
            Case 4 '4up size
                xSize = 352 / .Width
                ySize = 202 / .Height
        End Select
        
        If ySize <= xSize Then
            'use y
            .ScaleHeight ySize, 0 'msoFalse
            .ScaleWidth ySize, 0 'msoFalse
        Else
            'use x
            .ScaleHeight xSize, 0 'msoFalse
            .ScaleWidth xSize, 0 'msoFalse
        End If
        .LockAspectRatio = -1 'msoTrue
    End With

    ' Clean up
    PPApp.ActiveWindow.ViewType = 9 'ppViewNormal
    Set PPSlide = Nothing
    Set PPPres = Nothing
    Set PPApp = Nothing
End If

Beep

End Sub

 

[ChrisM]

Left out a bit, I call this sub from two other subs, both of which are tied to keyboard shortcuts. One for full page, one for 4-chart page:

Sub ExportPPT()
'export full size pic to PPT
' Keyboard Shortcut: Ctrl+e
    ExportPPTRoutine 1
End Sub

Sub ExportPPT4Up()
'export 4-up sized pic to PPT
' Keyboard Shortcut: Ctrl+r
    ExportPPTRoutine 4
End Sub

 

[Draperies]

Thank you Chris, this has definitely shed a lot of light onto how to go about doing this. However, this seems to paste a picture of the chart or table from excel into powerpoint with no link to the original excel file. I'm trying to get my charts into powerpoint and have the data entirely in powerpoint (still editable though), without linking to the excel file.

 

[ChrisM]

Oh, sorry I read your request differently. The line you would need to edit is here:

PPSlide.Shapes.PasteSpecial DataType:=2, _
Link:=0

Note that this is the late-binding version of this statement (so you don't need a hardcoded reference to PPT in VBA). The early-binding version, which I have commented out, is:

PPSlide.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile, _
Link:=msoFalse

You just need to change the DataType and Link bits, the rest of the code should hold true.

Actually I guess you don't want it linked, so the link part would stay as I've written it.

try it with:

PPSlide.Shapes.PasteSpecial DataType:=10, _
Link:=0

10 = ppPasteOLEObject

see if that gets it

 

[ChrisM]

not sure why I asked you to test it, only takes one second to change the code. This works, but when it pastes the embedded worksheet all my sizing code is thrown off. You just need to rework those parts and you should be all set.

The problem is my sizing code is looking for a shape on the slide, and the embedded worksheet is no longer a shape, it's an OLE object. Figure out how to reference the embedded sheet, then use that in all my sizing code.

 

[Draperies]

Thank you so much Chris, this has been a gigantic help!