2016-06-30 2 views
1

Excel 표의 모양으로 구성된 표를 복사하여 VBA를 사용하여 PowerPoint 슬라이드에 붙여 넣으려는 중입니다 (원본 서식 [Snapshot1]). 붙여 넣기 후 슬라이드의 이야기에 직접 쓰고 싶습니다. 모양이 테이블 [Snapshot2]에 붙여지지 않은 것을 제외하면 모든 것이 잘 작동하는 것 같습니다.Excel에서 PowerPoint로 표 복사 VBA

Sub CreatePP() 
    Dim ppapp As PowerPoint.Application 
    Dim ppPres As PowerPoint.Presentation 
    Dim ppSlide As PowerPoint.Slide 
    Dim ppTextBox As PowerPoint.Shape 
    Dim iLastRowReport As Integer 
    Dim sh As Object 
    Dim templatePath As String 

     On Error Resume Next 
     Set ppapp = GetObject(, "PowerPoint.Application") 
     On Error GoTo 0 

    'Let's create a new PowerPoint 
     If ppapp Is Nothing Then 
      Set ppapp = New PowerPoint.Application 
     End If 
    'Make a presentation in PowerPoint 
     If ppapp.Presentations.Count = 0 Then 
      Set ppPres = ppapp.Presentations.Add 
      ppPres.ApplyTemplate "C:\Users\luunt1\AppData\Roaming\Microsoft\Templates\Document Themes\themevpb.thmx" 
     End If 

    'Show the PowerPoint 
     ppapp.Visible = True 

     For Each sh In ThisWorkbook.Sheets 
     If sh.Name Like "E_KRI" Then 
      ppapp.ActivePresentation.Slides.Add ppapp.ActivePresentation.Slides.Count + 1, ppLayoutBlank 
      ppapp.ActiveWindow.View.GotoSlide ppapp.ActivePresentation.Slides.Count 
      Set ppSlide = ppapp.ActivePresentation.Slides(ppapp.ActivePresentation.Slides.Count) 
      ppSlide.Select 


      iLastRowReport = Range("B" & Rows.Count).End(xlUp).Row 
      Range("A1:J" & iLastRowReport).Copy 
      DoEvents 
      ppapp.CommandBars.ExecuteMso ("PasteExcelTableSourceFormatting") 
      Wait 3 
      With ppapp.ActiveWindow.Selection.ShapeRange 
       .Width = 700 
       .Left = 10 
       .Top = 75 
       .ZOrder msoSendToBack 
      End With 
      Selection.Font.Size = 12 
      'On Error GoTo NoFileSelected 
      AppActivate ("Microsoft PowerPoint") 
      Set ppSlide = Nothing 
      Set ppapp = Nothing 
    End If 
    Next 
End Sub 

Private Sub Wait(ByVal nSec As Long) 
    nSec = nSec + Timer 
    While nSec > Timer 
     DoEvents 
    Wend 
End Sub 
+0

수동에 배치했다 그 타원형 모양의 것들 엑셀 시트? – RGA

+0

예, 그렇습니다. 그것을 해결할 방법이 있습니까? 제발 도와주세요 –

+0

수동으로 배치 한 경우, 즉 셀에 연결되어 있지 않으면 솔루션이 쉬운 것이 아닙니다. 당신은 물체를 순환하고, 그 위치를 찾은 다음, 파워 포인트 시트의 상대적 위치를 결정하여 그곳에 배치해야합니다 – RGA

답변

0

오히려 테이블 및 붙여 넣기의 범위를 선택하는 것보다, 그렇게하는 대신 테이블 개체 자체를 붙여 솔루션을 해결할 수 있습니다 :

ActiveSheet.ListObjects(1).Copy 'Assuming it is the only table on the sheet. Adjust this code as needed for your specific case 
관련 문제