使用VBA将Excel图表复制到带有嵌入式数据的PowerPoint

Question

After pasting a chart in from Excel, there's a "Smart Tag" that pops up in the bottom right of the chart, from which one can select "Excel chart (entire workbook)" (as opposed to the default "Chart (linked to Excel data)"). This has the effect of embedding the data in the chart so that the data can still be modified, but the chart is not linked to the Excel file. Has anyone been able to replicate this using VBA (using either in Excel-VBA or PowerPoint-VBA)?

I haven't found any way to programmatically access the "Smart Tag" from VBA. Moreover, the Paste Special options do not seem to have an option for this.

I'm using Office 2007.

Answer 1

Try this Tahlor:

Option Explicit

' ===========================================================================================
' Copy Specified chart to PowerPoint whilst maintaining a data link.
' Written by : Jamie Garroch of YOUpresent Ltd. (UK)
' Date : 08 JULY 2015
' For more amazing PowerPoint stuff visit us at from http://youpresent.co.uk/
' ===========================================================================================
' Copyright (c) 2015 YOUpresent Ltd.
' Source code is provide under Creative Commons Attribution License
' This means you must give credit for our original creation in the following form:
' "Includes code created by YOUpresent Ltd. (YOUpresent.co.uk)"
' Commons Deed @ http://creativecommons.org/licenses/by/3.0/
' License Legal @ http://creativecommons.org/licenses/by/3.0/legalcode
' ===========================================================================================
' Macro Execution Environment : Designed to run in Excel VBA.
' ===========================================================================================
' You can use Early Binding (with the advantage that IntelliSense adds) by adding a reference
' to the PowerPoint Object Library and setting the compiler constant EARLYBINDING to True
' but delete it afterwards otherwise you will face a nightmare of compatibility!!!
' ===========================================================================================

#Const EARLYBINDING = False

Sub CopyPasteLinkedChartToPowerPoint()
#If EARLYBINDING Then
  ' Define Early Binding PowerPoint objects so you can use IntelliSense while debuggging
  ' Requires a reference (Tools/References) to the Microsoft PowerPoint XX.Y Object Library
  Dim oPPT As PowerPoint.Application
  Dim oPres As PowerPoint.Presentation
  Dim oSld As PowerPoint.Slide
#Else
  ' Define Late Binding PowerPoint objects
  ' Remove the reference to the Microsoft PowerPoint Object Library
  Dim oPPT As Object
  Dim oPres As Object
  Dim oSld As Object
  Const ppLayoutTitle = 1
#End If
  ' Define Excel objects
  Dim oWB As Workbook
  Dim oWS As Worksheet
  Dim oCHT As ChartObject

  Set oPPT = CreateObject("PowerPoint.Application")
  Set oPres = oPPT.Presentations.Add(msoTrue)
  Set oSld = oPres.Slides.Add(1, ppLayoutTitle)

  ' Modify these lines according to how you want to selet the chart
  Set oWB = ActiveWorkbook
  Set oWS = oWB.Worksheets(1)
  Set oCHT = oWS.ChartObjects(1)
  oCHT.Select
  ActiveChart.ChartArea.Copy

  ' Paste the chart to the PowerPoint slide with a data link
  oSld.Shapes.PasteSpecial link:=msoTrue

  ' Clear objects
  Set oPPT = Nothing: Set oPres = Nothing: Set oSld = Nothing
  Set oWB = Nothing: Set oWS = Nothing: Set oCHT = Nothing
End Sub

Answer 2

This is probably really bad form (posting as an answer to my question the answer to Joel's question in his answer), but the code below should help you with your question Joel. This is designed to be run from PowerPoint, and will delete all of the sheets that the selected chart doesn't use. Porting this to Excel should be pretty straightforward, just make sure chart1 is the PowerPoint chart you just pasted in and not the Excel chart you copied over. In any event, be extra careful to make sure that the graphs are being pasted in with the data (as opposed to being linked to the original workbook), as this code will delete every extra sheet in whatever workbook the chart references.

This has not been tested thoroughly. Obviously, back everything up.

'Delete extra sheets of selected chart in PowerPoint
Sub delete_excess_sheets()
Application.DisplayAlerts = False
Dim chart1 As Chart, used_sheets As Collection
Set chart1 = ActiveWindow.Selection.ShapeRange(1).Chart
chart1.ChartData.Activate
chart1.ChartData.Workbook.Application.DisplayAlerts = False

'Get sheets being used by chart
Set used_sheets = find_source(chart1)

For Each sht In chart1.ChartData.Workbook.worksheets 'this only loops through worksheets, not worksheet-charts
'note that you might first copy/paste values of the sheet supporting the data, if that sheet itself refers to other sheets
    If Not InCollection(used_sheets, sht.Name) Then
        sht.Delete
    End If
Next

Application.DisplayAlerts = True
chart1.ChartData.Workbook.Application.DisplayAlerts = True

End Sub

'Determine which sheets are being used by the chart
Function find_source(search_cht As Object) As Collection

Dim strTemp As String, sheet_collection As New Collection
For Each mysrs In search_cht.SeriesCollection
    first_part = Split(Split(mysrs.Formula, "!")(0), "=SERIES(")(1)
    If (InStr(first_part, "'") = 1 And Right(first_part, 1) = "'") Then first_part = Mid(first_part, 2, Len(first_part) - 2)
    sheet_collection.Add first_part, first_part
Next
Set find_source = sheet_collection

End Function

'Determine if object is in a collection
Public Function InCollection(col As Collection, key As String) As Boolean
  Dim var As Variant
  Dim errNumber As Long

  InCollection = False
  Set var = Nothing

  err.Clear
  On Error Resume Next
    var = col.Item(key)
    errNumber = CLng(err.Number)
  On Error GoTo 0

  '5 is not in, 0 and 438 represent incollection
  If errNumber = 5 Then ' it is 5 if not in collection
    InCollection = False
  Else
    InCollection = True
  End If

End Function