Kopierbereich von Excel-Tabelle zu Tabelle in Powerpoint mit VBA

Question

Ich habe versucht, diesen Code für die Bewältigung Bereich von Excel-Tabelle zu Bereich der Tabelle in Powerpoint zu verwenden. Aber es wurde nicht ausgeführt. Bitte helfen.

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("A3:J" & iLastRowReport).Copy 
    Set tbl = ppapp.ActiveWindow.Selection.ShapeRange.Table 
    tbl.Cell(5,3).Shape.paste 

Answer 1

Ich habe den folgenden Code:

1. Es setzt die Powerpoint-Anwendung, Pres und Dia-Auswahl Einstellungen.
2. Durchläuft alle Formen in der ausgewählten Folie und sucht nach der Form des Tabellentyps.
3. Kopiert den Bereich aus dem Excel-Arbeitsblatt.
4. Es wählt die gewünschte Tabellenzelle als erste Zeile und Spalte zum Kopieren des Excel-Bereichs aus.

5. In bestehende Tabelle einfügen, entweder mit dem PowerPoint-Tabellenformat oder dem Excel-Bereichsformat.

   Public Sub ExcelRange_to_PPT_Table() 
   
   Dim ppApp        As PowerPoint.Application 
   Dim ppPres        As PowerPoint.Presentation 
   Dim ppTbl        As PowerPoint.Shape 
   
   
   On Error Resume Next 
   Set ppApp = GetObject(, "PowerPoint.Application") 
   On Error GoTo 0 
   
   If ppApp Is Nothing Then 
       Set ppApp = New PowerPoint.Application 
       Set ppPres = ppApp.Presentations.Item(1) 
   Else 
       Set ppPres = ppApp.Presentations.Item(1) 
   End If 
   
   ppApp.ActivePresentation.Slides(1).Select 
   ppPres.Windows(1).Activate 
   
   
   ' find on Slide Number 1 which object ID is of Table type (you can change to whatever slide number you have your table) 
   With ppApp.ActivePresentation.Slides(1).Shapes 
       For i = 1 To .count 
        If .Item(i).HasTable Then 
         ShapeNum = i 
        End If 
       Next 
   End With 
   
   ' assign Slide Table object 
   Set ppTbl = ppApp.ActivePresentation.Slides(1).Shapes(ShapeNum) 
   
   ' copy range from Excel sheet 
   iLastRowReport = Range("B" & Rows.count).End(xlUp).row 
   Range("A3:J" & iLastRowReport).Copy 
   
   ' select the Table cell you want to copy to >> modify according to the cell you want to use as the first Cell 
   ppTbl.Table.Cell(3, 1).Shape.Select 
   
   ' paste into existing PowerPoint table - use this line if you want to use the PowerPoint table format 
   ppApp.CommandBars.ExecuteMso ("PasteExcelTableDestinationTableStyle") 
   
   ' paste into existing PowerPoint table - use this line if you want to use the Excel Range format 
   ' ppApp.CommandBars.ExecuteMso ("PasteExcelChartSourceFormatting") 
   
   End Sub