如何从Powerpoint将表(形状)导出为JPG

时间:2013-03-21 15:53:40

标签: vba powerpoint powerpoint-vba

我可以将图表作为JPG文件从Powerpoint导出,但是无法使用表格进行处理,据我所知,这仍然是一个应该能够导出的“形状”。

这是我用来将图表导出为JPG的代码的清理版本。

Const imgFilePath as String = "ChartImage.JPG"
Sub ExportChartJPG()
Dim cht as Variant  'this will hold the Chart/Shape object

Set cht = ActivePresentation.Slides(1).Shapes("Chart1").Chart

On Error Resume Next
    Kill imgPath
On Error GoTo 0

cht.Export imgPath, "JPG"

End Sub

我认为这很容易修改,例如:

Sub ExportChartJPG()
Dim cht as Variant  'this will hold the Chart/Shape object

Set cht = ActivePresentation.Slides(1).Shapes("Table1").Table

On Error Resume Next
    Kill imgPath
On Error GoTo 0

cht.Export imgPath, "JPG"

End Sub

但这会导致错误13不匹配。

我还尝试将cht标注为Shape而不是Variant,并设置cht = ActivePresentation.Slides(1).Shapes("Table1"),但也未成功。

2 个答案:

答案 0 :(得分:5)

尽管KazJaw的解决方案有效,但它有点麻烦(复制需要额外的时间来处理,我认为由于没有“等待”足够长时间来完成复制,剪贴板问题等等而导致错误。)< / p>

http://www.tech-archive.net/pdf/Archive/Office/microsoft.public.office.developer.vba/2006-10/msg00046.pdf

我打开对象浏览器,右键单击并显示隐藏的方法,现在允许我在Export上使用Shape方法。

Sub ExportShapeJPG()
Dim cht as Variant  'this will hold the Chart/Shape object

Set cht = ActivePresentation.Slides(1).Shapes("Table1") '<-- removed .Table and only pass the Shape itself

'Likewise, for charts, omit the .Chart:
' Set cht = ActivePresentation.Slides(1).Shapes("Chart1") 


On Error Resume Next
    Kill imgPath
On Error GoTo 0

cht.Export imgPath, ppShapeFormatJPG  '<-- The export syntax is slightly different using ppShapeFormatJPG instead of "JPG"

End Sub

答案 1 :(得分:3)

我有一个非常奇怪的想法。查看第一部分保存图表和第二个保存表的代码。

Sub ExportinChartAndTable()
Dim imgFilePath As String
    imgFilePath = ActivePresentation.Path & "\chart"

Dim shp As Shape
    Set shp = ActivePresentation.Slides(1).Shapes(1)
Dim shpChart As Chart
    Set shpChart = shp.Chart
'exporting chart
On Error Resume Next
    Kill imgFilePath
On Error GoTo 0
shpChart.Export imgFilePath & "chart.jpg", "JPG"

Stop
Dim chartPart As ChartData
    Set chartPart = shpChart.ChartData

imgFilePath = ActivePresentation.Path & "\dataTable.jpg"

chartPart.Workbook.worksheets("arkusz1").Range("a1:c20").Copy
shpChart.Paste
shpChart.Shapes(1).Width = shp.Width
shpChart.Shapes(1).Height = shp.Height
On Error Resume Next
    Kill imgFilePath
On Error GoTo 0
shpChart.Export imgFilePath, "JPG"


End Sub

你必须想出如何检查表的范围。我希望CurrentRegion可行,但事实并非如此。您可以使用计算表中行和列的数量的可能性(这是可能的)。或者你可能有固定的范围,所以很容易。还有一件事,你必须在调整表格大小时调整尺寸。

由于David的评论而编辑。我保留上述解决方案对其他人有用(请参阅下面的评论)

Sub SolutionSecond()

Dim whereTo As String
    whereTo = ActivePresentation.Path & "\table.jpg"
Dim shp As Shape
Set shp = ActivePresentation.Slides(1).Shapes(1)



Dim chrt As Shape
Set chrt = ActivePresentation.Slides(1).Shapes.AddChart

shp.Copy

'required due to excel opening proces
    chrt.Select
    chrt.Chart.Paste

'set dimensions here
chrt.Chart.Export whereTo, "JPG"

    chrt.Delete
 End Sub

这一个基于相同的逻辑。将表复制到图表中(可以导出唯一的Shape)。