ExcelテーブルからExcelテーブルへのコピーVBA

Question

Excelシートからシェイプで構成されたテーブルをコピーし、VBAを使用してPowerPointスライドに貼り付けようとしています。ソースフォーマット[]を保持しています。 貼り付けた後にスライドの物語に直接書きたいと思います。形状がテーブル[]に貼り付けられなかった以外は、すべてうまくいくようです。

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 

Answer 1

ではなく、テーブルと貼り付けの範囲を選択し、それはそうではなく、テーブルオブジェクト自体を貼り付けるためにあなたのソリューションを解決することがあります。

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