如何从Powerpoint以JPG格式导出表格（形状）

Question

我可以将PowerPoint导出为JPG格式的文件，但无法使用表格进行此操作，据我所知，仍然是一张表格应该能够输出的“形状”。

这是我用来将图表导出为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而不是Variant，并且设置cht = ActivePresentation.Slides(1).Shapes("Table1")也失败。

Answer 1

虽然KazJaw的解决方案有效，但它有点麻烦（复制需要额外的时间来处理，我想因为没有“等待”足够长的时间来完成复制，剪贴板问题等等，

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 

Answer 2

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

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可以工作，但事实并非如此。你可以用这个可能性来计算表中的行和列的数量（这是可能的）。或者，也许你有固定的范围，所以它会很容易。还有一件事，你必须在调整表格大小时调整维度。

编辑由于大卫评论。我保持上述溶液代替作为可以为其他有用（请参考下面的注释）

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 

在相同的逻辑这一种碱。将表格复制到可以导出（唯一形状）的图表中。