Export Excel Charts as Images using Powerpoint VBA -
i have below code have written export "chart1" excel sheet called "sheet1" new slide in created instance of powerpoint:
sub chartstopowerpoint() dim pptapp powerpoint.application dim pptpres powerpoint.presentation dim pptslide powerpoint.slide dim pptslidecount integer dim ws worksheet dim intchnum integer dim objch object 'open powerpoint , create new presentation. set pptapp = new powerpoint.application set pptpres = pptapp.presentations.add 'set chart , copy new ppt slide set objchart = worksheets("sheet1").chartobjects("chart 1").chart objchart.chartarea.copy set pptslide = pptpres.slides.add(pptslidecount + 1, pplayoutblank) pptslide.shapes.pastespecial pppastejpg 'format picture size/position. j = 1 pptslide.shapes.count pptslide.shapes(j) if .type = msopicture .top = 87 .left = 33 .height = 422 .width = 646 end if end next j pptapp.visible = true set pptslide = nothing set pptpres = nothing set pptapp = nothing end sub
the reason not using .chart.export
method because of poor quality output getting when using excel 2007 sp3.
what looking next save copied image powerpoint .png , close powerpoint presentation without saving changes.
please assist.
never mind figured out:
sub chartstopowerpoint() dim pptapp powerpoint.application dim pptpres powerpoint.presentation dim pptslide powerpoint.slide 'open powerpoint , create invisible new presentation. set pptapp = new powerpoint.application set pptpres = pptapp.presentations.add(msofalse) 'set charts , copy them new ppt slide 'i have used every chart object line 'but have 2 charts set objchart = worksheets("sheet1").chartobjects("chart 1").chart objchart.chartarea.copy set pptslide = pptpres.slides.add(1, pplayoutblank) pptslide.shapes.paste set objchart = worksheets("sheet1").chartobjects("chart 2").chart objchart.chartarea.copy pptslide.shapes.paste 'save images png path = "c:\users\xyz\desktop\" j = 1 pptslide.shapes.count pptslide.shapes(j) .export path & j & ".png", ppshapeformatpng end next j pptapp.quit set pptslide = nothing set pptpres = nothing set pptapp = nothing end sub
Comments
Post a Comment