파워 포인트에서 JPG로 표 (도형)를 내보내는 방법

Question

파워 포인트에서 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을 변형 대신 모양으로 사용하고 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이 효과가 있기를 바랐지만 그렇지 않았습니다. 테이블의 행과 열의 수를 계산할 수 있습니다 (가능한 경우도 있음). 아니면 범위가 고정되어있어 쉽습니다. 한 가지 더, 테이블의 크기를 조정할 때 치수를 조정해야합니다.

데이빗 코멘트로 인해 편집. 다른 사람을 위해 도움이 될 수 있기 때문에 I (아래 설명 참조) 대신에 위의 솔루션을 유지

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 

같은 논리에이 하나 개의 기본. 표를 내보낼 수있는 차트로 표를 복사하십시오.