I'm trying to copy and paste a table consisting of shape from an Excel Sheet into a PowerPoint slide using VBA keeping its source formatting [ ]. I want to write directly on the tale on the slide after paste. Everything seems to work fine except the shape was not pasted into the table [
].
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
它不是选择表格和粘贴的范围,而是可以解决您的解决方案而不是粘贴表格对象本身,因此:
ActiveSheet.ListObjects(1).Copy 'Assuming it is the only table on the sheet. Adjust this code as needed for your specific case
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.