我正在尝试创建一个宏来清理功率点图表后面的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
答案 0 :(得分:0)
试试这个:
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