更新时间:2021-08-04 23:09:08
PasteSpecial
和 CommandBars.ExecuteMso
应该都可以工作(在Excel / PowerPoint 2010中对代码进行了以下警告:
PasteSpecial
and CommandBars.ExecuteMso
should both work (tested your code in Excel/PowerPoint 2010 with the following caveat:
添加演示文稿时,您必须打开它 WithWindow:= True
When you add presentation, you have to open it WithWindow:=True
Set pptPres = pptApp.Presentations.Add(msoCTrue)
我做了更多的挖掘工作,您需要使用 CopyPicture
方法,然后我可以打开withwindow = False
。尝试:
I did some more digging, you need to use the CopyPicture
method and then I think you can open withwindow=False
. Try:
Sub ChartsToPowerPoint()
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim objChart As Chart
'Open PowerPoint and create an invisible new presentation.
Set pptApp = New PowerPoint.Application
Set pptPres = pptApp.Presentations.Add(msoFalse)
Set objChart = Worksheets("Sheet1").ChartObjects("Chart 1").Chart
objChart.CopyPicture
Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
pptSlide.Shapes.PasteSpecial DataType:=ppPasteDefault, Link:=msoFalse
'Save Images as png
Path = CreateObject("Wscript.Shell").SpecialFolders("Desktop") & "\"
For j = 1 To pptSlide.Shapes.Count
With pptSlide.Shapes(j)
.Export Path & j & ".png", ppShapeFormatPNG
End With
Next j
pptApp.Quit
Set pptSlide = Nothing
Set pptPres = Nothing
Set pptApp = Nothing
End Sub