모든 Excel 시트의 모든 테이블과 차트를 PowerPoint로 복사

Question

Excel에서 매크로 (VBA)를 사용하여 모든 시트의 Excel 파일에서 PowerPoint 파일로 모든 차트와 테이블을 복사하려면 코드 조각이 필요합니다.

아래 코드는 차트 만 복사합니다. 모든 테이블과 차트 및 이미지를 복사하고 싶습니다. 사진을

Sub PushChartsToPPT() 
'Set reference to 'Microsoft PowerPoint 12.0 Object Library' 
'in the VBE via Tools > References... 
' 
Dim ppt As PowerPoint.Application 
Dim pptPres As PowerPoint.Presentation 
Dim pptSld As PowerPoint.Slide 
Dim pptCL As PowerPoint.CustomLayout 
Dim pptShp As PowerPoint.Shape 

Dim cht As Chart 
Dim ws As Worksheet 
Dim i As Long 

'Get the PowerPoint Application object: 
Set ppt = CreateObject("PowerPoint.Application") 
ppt.Visible = msoTrue 
Set pptPres = ppt.Presentations.Add 

'Get a Custom Layout: 
For Each pptCL In pptPres.SlideMaster.CustomLayouts 
    If pptCL.Name = "Title and Content" Then Exit For 
Next pptCL 

'Copy ALL charts in Chart Sheets: 
For Each cht In ActiveWorkbook.Charts 
    Set pptSld = pptPres.Slides.AddSlide(pptPres.Slides.Count + 1, pptCL) 
    pptSld.Select 

    For Each pptShp In pptSld.Shapes.Placeholders 
     If pptShp.PlaceholderFormat.Type = ppPlaceholderObject Then Exit For 
    Next pptShp 
    If pptShp Is Nothing Then Stop 

    cht.ChartArea.Copy 
    ppt.Activate 
    pptShp.Select 
    ppt.Windows(1).View.Paste 
Next cht 

'Copy ALL charts embedded in EACH WorkSheet: 
For Each ws In ActiveWorkbook.Worksheets 
    For i = 1 To ws.ChartObjects.Count 
     Set pptSld = pptPres.Slides.AddSlide(pptPres.Slides.Count + 1, pptCL) 
     pptSld.Select 

     For Each pptShp In pptSld.Shapes.Placeholders 
      If pptShp.PlaceholderFormat.Type = ppPlaceholderObject Then Exit For 
     Next pptShp 

     Set cht = ws.ChartObjects(i).Chart 
     cht.ChartArea.Copy 
     ppt.Activate 
     pptShp.Select 
     ppt.Windows(1).View.Paste 
    Next i 
    Next ws 
End Sub 

Answer 1

는 How to select pictures

Dim Pic As Shape 
For Each Pic In ActiveSheet.Shapes 
    If Pic.Type = msoPicture Then 
     Pic.Select 
     'do something with image 
    End If 
Next Pic