Hi all,
I currently have a dynamic excel dashboard that i have added export to PDF and export to PP macro options to that are run via command box click. These options allow the user to run off static views for adding to bigger presentation packs or to take along to meetings where drill-down functionality isn't required.
For a number of years i've used Peltier's VBA code that automates copying and pasting the various excel tabs into a PP workbook. However, i've always manually then broken links before sending on (as else when i change the view in the dynamic excel master, my end user gets a different view than intended).
The latest dashboard i'm going to open up as a self serve report (with calculation sheets hidden and a working master retained!). Therefore i'd like to adapt the code to automatically break the links so that the users can export one by one a variety of static PP slides with different dashboard filters selected on each.
This is Peltier code i'm currently using ;
In this case i'm exporting the excel dashboard as a single image ("Export Range" from a single tab "Display". From a bit of googling around the subject i did try to insert the follow line :
to the PasteRange as Picture section however i'm getting an error trying to do that.
Any thoughts/advice/suggested code would be very welcome. It looks like the existing code actually already allows for pasting charts unlinked but can i make it work for image files? (My dashboard range that i'm copying contains titles, footers, text - not just charts)
Thanks
Scott
I currently have a dynamic excel dashboard that i have added export to PDF and export to PP macro options to that are run via command box click. These options allow the user to run off static views for adding to bigger presentation packs or to take along to meetings where drill-down functionality isn't required.
For a number of years i've used Peltier's VBA code that automates copying and pasting the various excel tabs into a PP workbook. However, i've always manually then broken links before sending on (as else when i change the view in the dynamic excel master, my end user gets a different view than intended).
The latest dashboard i'm going to open up as a self serve report (with calculation sheets hidden and a working master retained!). Therefore i'd like to adapt the code to automatically break the links so that the users can export one by one a variety of static PP slides with different dashboard filters selected on each.
This is Peltier code i'm currently using ;
Code:
Sub Copy_Paste_to_PowerPoint()
'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
'Original code sourced from Jon Peltier [URL]http://peltiertech.com/Excel/XL_PPT.html[/URL]
'This code developed at [URL]http://oldlook.experts-exchange.com:8080/Applications/MS_Office/Excel/Q_21337053.html[/URL]
Dim SheetName As String
Dim TestRange As Range
Dim TestSheet As Worksheet
Dim TestChart As ChartObject
Dim PasteChart As Boolean
Dim PasteChartLink As Boolean
Dim ChartNumber As Long
Dim PasteRange As Boolean
Dim RangePasteType As String
Dim RangeName As String
Dim AddSlidesToEnd As Boolean
'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" or "Picture". See routine below for exact values
'RangeName - Address or name of range to copy; "B3:G9" "MyRange"
'AddSlidesToEnd - If True then appednd slides to end of presentation and paste. If False then paste on current slide.
'use active sheet. This can be a direct sheet name
SheetName = "Display1"
'Setting PasteRange to True means that Chart Option will not be used
PasteRange = True
RangeName = "ExportRange"
RangePasteType = "Picture"
RangeLink = True
PasteChart = True
PasteChartLink = True
ChartNumber = 1
AddSlidesToEnd = True
'Error testing
On Error Resume Next
Set TestSheet = Sheets(SheetName)
Set TestRange = Sheets(SheetName).Range(RangeName)
Set TestChart = Sheets(SheetName).ChartObjects(ChartNumber)
On Error GoTo 0
If TestSheet Is Nothing Then
MsgBox "Sheet " & SheetName & " does not exist. Macro will exit", vbCritical
Exit Sub
End If
If PasteRange And TestRange Is Nothing Then
MsgBox "Range " & RangeName & " does not exist. Macro will exit", vbCritical
Exit Sub
End If
If PasteRange = False And PasteChart And TestChart Is Nothing Then
MsgBox "Chart " & ChartNumber & " does not exist. Macro will exit", vbCritical
Exit Sub
End If
'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 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
If AddSlidesToEnd 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)
Else
'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" Then
'Paste Range as Picture
Worksheets(SheetName).Range(RangeName).Copy
ppSlide.Shapes.PasteSpecial(ppPasteDefault, link:=RangeLink).Select
Else
'Paste Range as HTML
Worksheets(SheetName).Range(RangeName).Copy
ppSlide.Shapes.PasteSpecial(ppPasteHTML, link:=RangeLink).Select
End If
Else
'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
Else
'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.Top = 25
ppApp.ActiveWindow.Selection.ShapeRange.Left = 2
ppApp.ActiveWindow.Selection.ShapeRange.Width = 730
ppApp.ActiveWindow.Selection.ShapeRange.Height = 445
Set ppSlide = Nothing
Set ppApp = Nothing
End Sub
Code:
ppApp. ActivePresentation.LinkFormat.BreakLink
Any thoughts/advice/suggested code would be very welcome. It looks like the existing code actually already allows for pasting charts unlinked but can i make it work for image files? (My dashboard range that i'm copying contains titles, footers, text - not just charts)
Thanks
Scott