从Excel复制表到PowerPoint VBA

我试图从Excel表格复制和粘贴一张表格形成一个PowerPoint幻灯片使用VBA保持其源格式[ 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

来源

2016-06-30 Luu nguyen

那些是椭圆形那些手动放置在excel表单？ – RGA

是的。你有什么办法解决它？请帮助我 –

如果它们是手动放置的，即未链接到单元格，那么解决方案将不是一件容易的事。您将需要循环浏览物体，找到它们的位置，然后确定在PowerPoint中的相对位置以将它们放置在那里 – RGA

而不是选择表和粘贴的范围内，它可以解决您的溶液，而不是粘贴表对象本身，所以：

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

来源

2016-06-30 12:47:22 RGA

从Excel复制表到PowerPoint VBA

回答

相关问题