如何从 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 Mismatch。

我还尝试将cht 标注为形状而不是变体，并将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

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

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

由于 David 的评论而进行编辑。我保留了上述解决方案，因为它可能对其他人有用（请参阅下面的 cmets）

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

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