如何将excel中的预定义范围数组作为嵌入/链接粘贴到powerpoint中？

我曾尝试在internet上混合具有类似功能的不同代码，以产生所需的效果。但是，对于数组中预定义的范围，我意识到该范围不会粘贴为嵌入/链接

我试图在新的powerpoint幻灯片中为每张幻灯片设置一个范围，以便于报告。到目前为止，代码确实会将所有范围粘贴到一个新的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

与此相反：

'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

---

你能解释一下你的解决方案是如何工作的吗？我不太清楚它是如何工作的。哈哈，谢谢你。