Question

我尝试在互联网上使用类似功能的不同代码进行混搭以产生所需的效果，但是在阵列中使用预定义的范围，我意识到该范围不会被粘贴为嵌入/链接。

我尝试在新的幻灯片幻灯片中为每张幻灯片设置一个范围，以便于报告。到目前为止，代码会将所有范围粘贴到每个幻灯片1个范围的新ppt中，但不会将其粘贴为嵌入。有什么方法可以解决这个问题吗？

Sub ExcelRangeToPowerPoint()
'PURPOSE: Copy/Paste An Excel Range Into a New PowerPoint Presentation
'SOURCE: www.TheSpreadsheetGuru.com

Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
Dim MyRangeArray As Variant
Dim oPPTApp As PowerPoint.Application
Dim x As Long

MyRangeArray = _
Array( _
Sheets("All DDR").Range("A3:J11"), Sheets("All DDR").Range("A13:J21"), 
Sheets("All DDR").Range("A23:J31"), _
Sheets("All DDR").Range("A33:J41"), Sheets("All DDR").Range("A43:J51"), 
Sheets("All DDR").Range("A53:J61"), _
Sheets("All DDR").Range("A63:J71"), Sheets("All DDR").Range("A73:J81"), 
Sheets("All DDR").Range("A83:J91"), _
Sheets("All DDR").Range("A93:J101"), Sheets("All 
DDR").Range("A103:J111"), _
 _
Sheets("TNR DDR").Range("A3:J11"), Sheets("TNR DDR").Range("A13:J21"), 
Sheets("TNR DDR").Range("A23:J31"), _
Sheets("TNR DDR").Range("A33:J41"), Sheets("TNR DDR").Range("A43:J51"), 
Sheets("TNR DDR").Range("A53:J61"), _
Sheets("TNR DDR").Range("A63:J71"), Sheets("TNR DDR").Range("A73:J81"), 
Sheets("TNR DDR").Range("A83:J91"), _
Sheets("TNR DDR").Range("A93:J101"), Sheets("TNR 
DDR").Range("A103:J111"), _
_
Sheets("BE2 DDR").Range("A3:J11"), Sheets("BE2 DDR").Range("A13:J21"), 
Sheets("BE2 DDR").Range("A23:J31"), _
Sheets("BE2 DDR").Range("A33:J41"), Sheets("BE2 DDR").Range("A43:J51"), 
Sheets("BE2 DDR").Range("A53:J61"), _
Sheets("BE2 DDR").Range("A63:J71"), Sheets("BE2 DDR").Range("A73:J81"), 
Sheets("BE2 DDR").Range("A83:J91"), _
Sheets("BE2 DDR").Range("A93:J101"), Sheets("BE2 
DDR").Range("A103:J111"), _
_
Sheets("FE+BE1 DDR").Range("A3:J11"), Sheets("FE+BE1 
DDR").Range("A13:J21"), Sheets("FE+BE1 DDR").Range("A23:J31"), _
Sheets("FE+BE1 DDR").Range("A33:J41"), Sheets("FE+BE1 
DDR").Range("A43:J51"), Sheets("FE+BE1 DDR").Range("A53:J61"), _
Sheets("FE+BE1 DDR").Range("A63:J71"), Sheets("FE+BE1 
DDR").Range("A73:J81"), Sheets("FE+BE1 DDR").Range("A83:J91"), _
Sheets("FE+BE1 DDR").Range("A93:J101"), Sheets("FE+BE1 
DDR").Range("A103:J111") _
)

'Create an Instance of PowerPoint
 On Error Resume Next

'Is PowerPoint already opened?
  Set PowerPointApp = GetObject(class:="PowerPoint.Application")

'Clear the error between errors
  Err.Clear

'If PowerPoint is not already open then open PowerPoint
  If PowerPointApp Is Nothing Then Set PowerPointApp = 
CreateObject(class:="PowerPoint.Application")

'Handle if the PowerPoint Application is not found
  If Err.Number = 429 Then
    MsgBox "PowerPoint could not be found, aborting."
    Exit Sub
  End If

 On Error GoTo 0

'Optimize Code
 Application.ScreenUpdating = False

'Create a New Presentation
 Set myPresentation = PowerPointApp.Presentations.Add

'Copy Range from Excel
For x = 0 To 43
Set rng = MyRangeArray(x)
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 11) '11 = ppLayoutTitleOnly

'Copy Excel Range

rng.Copy

'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial (Link = True)
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

'Set position:
  myShape.Left = 66
  myShape.Top = 152

'Make PowerPoint Visible and Active
 PowerPointApp.Visible = True
 PowerPointApp.Activate

'Clear The Clipboard
 Application.CutCopyMode = False
 Next

End Sub

Answer 1

而不是：

'Paste to PowerPoint and position
mySlide.Shapes.PasteSpecial (Link = True)
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

尝试使用PPT获取链接的Excel对象：

' Instead of pasting something and then getting a reference to it,
' you can set myShape to the result of the paste directly

    Set myShape = mySlide.Shapes.PasteSpecial(0, False, , , , True)(1)

' The parameters to .PasteSpecial are:
' DataType ( 0 = OLE object )
' DisplayAsIcon (we don't want that, so False)
' IconFileName (we don't care so don't specify anything)
' IconIndex (we don't care, so don't specify anything)
' IconLabel (again, nothing)
' Link (yes, so True)
'
' The (1) at the end is because PasteSpecial returns a ShapeRange, 
' not a shape, but we want a shape, so we ask for the first member
' of the shaperange

如何将excel的预定义范围数组粘贴到powerpoint中作为embed / linked？

1 个答案: