在 Excel 中打开 Powerpoint 图表数据

Question

我正在尝试创建一个宏来清理 power point 中图表后面的 Excel 工作表，以便只有图表中使用的数据存在，没有公式。

我已经拼凑了这个，当我在 Excel 中打开图表数据时，它可以工作，但我希望我可以创建一个宏，循环遍历工作簿中的每个图表并为我在 Excel 中打开图表数据，所以我可以对每个执行以下操作。

Sub ChartCleaningPP()

'Paste values of table

    Range("Table1[#All]").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Dim Cell As Range

'clear other cells

For Each Cell In ActiveSheet.UsedRange
If Intersect(Cell, Selection) Is Nothing Then
Cell.Clear
End If
Next Cell

'remove hidden

For lp = 256 To 1 Step -1
If Columns(lp).EntireColumn.Hidden = True Then Columns(lp).EntireColumn.Delete Else
Next
For lp = 65536 To 1 Step -1
If Rows(lp).EntireRow.Hidden = True Then Rows(lp).EntireRow.Delete Else
Next

'close window

ActiveWindow.Close

End Sub

Answer 1

试试这个：

Sub ChangeCharts()
Dim ws As Worksheet
Dim myChart As ChartObject

   For Each ws In ThisWorkbook.Worksheets
      For Each myChart In ws.ChartObjects
        'your code here
        'i.e Call ChartCleaningPP
        Next myChart
    Next ws
End Sub

编辑：（从 PP 运行 Excel Makro） 需要在 PP 中激活 MS Excel 库。

Sub RunExcelMakro()
Dim wk As Object
Dim Path As String
CreateObject ("Excel.Application")
Set xlApp = New Excel.Application
xlApp.Visible = True

Path = "C:\Users\User\Desktop\F\1.xlsm" 'Edit Path
Set wk = xlApp.Workbooks.Open(Path)

xlApp.Run "YourMakro"

xlApp.Quit
End Sub

编辑：

Sub M1()
    Dim sld As Slide
    Dim sh As Shape
    Dim Path As String

    Dim xlApp As Object
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True

    For Each sld In ActivePresentation.Slides
        For Each sh In sld.Shapes
            If sh.Type = msoLinkedOLEObject Then
                With sh.LinkFormat
                    Path = .SourceFullName
                    xlApp.Workbooks.Open Path

                End With
            End If
        Next sh
    Next sld
End Sub