Excel到PPT动态数组

我有VBA代码，其中包含Excel到PPT的范围。所以我的问题是如何设置一个动态范围，而不是在这里给出数组值

下面的示例代码希望在动态中使用相同的代码：-

MySlideArray = Array(5, 7, 9, 11, 13, 15, 17, 18, 20, 22, 24, 26, 27, 28, 31)

MyRangeArray = Array(Sheet4.Range("A10:AS69"), Sheet9.Range("Q10:AH69"), Sheet10.Range("A1:AX65"), Sheet11.Range("A1:A12"), Sheet12.Range("A1:A12"), Sheet13.Range("A1:A12"), Sheet14.Range("A1:A12"), Sheet15.Range("A1:A12"), Sheet16.Range("A1:A12"), Sheet17.Range("A1:A12"), Sheet18.Range("A1:A12"), Sheet19.Range("A1:A12"), Sheet20.Range("A1:A12"), Sheet21.Range("A1:A12"), Sheet22.Range("A1:A12"))

我有一个报告卡，其中包含Excel范围内的所有工作表，因此当我参考数组时，它应该捕获报告卡范围

前

如何建立动态范围

ub copiSylwadau（）

'用途：复制Excel范围并将其粘贴到活动的PowerPoint演示文稿幻灯片中 来源：www.TheSpreadsheetGuru.com

作为对象的演示文稿 暗mySlide作为对象 Dim PowerPointApp作为对象 将小水电作为对象 作为变体的Dim数组 Dim MyRange数组作为变量 暗x等长 Dim MyArray作为变体 作为整数的Dim I计数器

'创建PowerPoint的实例 出错时继续下一步

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

'Clear the error between errors
  Err.Clear

'If PowerPoint is not already open then Exit
  If PowerPointApp Is Nothing Then
    MsgBox "PowerPoint Presentation is not open, aborting."
    Exit Sub
  End If

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

错误转到0

'使PowerPoint可见并处于活动状态 PowerPointApp.ActiveWindow.Panes（2）.激活

'创建新的演示文稿 设置myPresentation=PowerPointApp.ActivePresentation

'要粘贴到的PPT幻灯片列表 'MyArray=工作表（“控制”）.范围（“rng”） 'MsgBox“MyArray” MySlideArray=Array（5,7,9,11,13,15,17,18,20,22,24,26,27,28,31）

'要从中复制的Excel范围列表 MyRangeArray=数组（Sheet4.Range（“A1:A12”）、Sheet9.Range（“A1:A12”）、Sheet10.Range（“A1:A12”）、Sheet11.Range（“A1:A12”）、Sheet13.Range（“A1:A12”）、Sheet14.Range（“A1:A12”）、Sheet16.Range（“A1:A12”）、Sheet17.Range（“A1:A12”）、Sheet18.Range（“A1:A12”）、Sheet19.Range（“A1:A12”）、Sheet20.Range（“A1:A12”），活页21.范围（“A1:A12”），活页22.范围（“A1:A12”））

'循环遍历数组数据 对于x=LBound（MySlideArray）到UBound（MySlideArray） '复制Excel范围 MyRangeArray（x）.复制 '如果i计数器=i计数器<2，则

    'If rCell And Not rCell.Offset(0, 2) Then
        'copy slide template
        'myPresentation.Slides(4).Copy
        'Set obSlide = myPresentation.Slides.Paste(Index:=iCounter)
       ' iCounter = iCounter
      ' End If

'Paste to PowerPoint and position
  On Error Resume Next
    Set shp = myPresentation.Slides(MySlideArray(x)).Shapes.PasteSpecial(DataType:=ppPasteOLEObject, Link:=True)
    Set shp = PowerPointApp.ActiveWindow.Selection.ShapeRange
    Set MySlideArray = myPresentation.Add(myPresentation.Count + 1)

  On Error GoTo 0

  'Center Object
  With myPresentation.PageSetup
    shp.Left = 20
    shp.Top = 70
    shp.Width = 670
     'shp.Height = ppAutoSizeShapeToFitText


End With

下一个x

“转移完成 Application.CutCopyMode=False 此工作簿。激活 MsgBox“Cyflwyniad PowerPoint wedi eu greu！”

---

End Sub

建议您直接创建命名范围，然后引用代码中的范围。 示例：使用名称“Sheet4Range”来命名Sheet4.Range（“A10:AS69”） 在代码中：

Sheet4.Range("Sheet4Range")

---

可以将实际Sheet4Range范围的定义设置为动态命名范围（DNR）。有许多资源可以学习如何构建DNR。这里有一个：

Hi Smiley感谢您的支持，此案例与其他案例没有什么不同表名Visibility表头摘要TRUE K10:AS69 BU9 KPI提高TRUE K10:AH69 BU9 KPI解决TRUE K10:AX65 BU9 KPI打开TRUE K10:AX65 BU9未分配FALSE G15:P70 F8重新打开FALSE G15:P70 F8 am无法像方框一样发布。所以我的问题是，我有一个代码，可以帮助我们将excel中的数据复制粘贴到ppt，我们在头版中提到的范围，所以它太复杂了，无法指定您上面提到的范围。因为当我单击时，我们有超过50张可用的图纸。您使用什么来确定要使用的范围？范围是否相同，只是工作簿不同？对你的代码发表评论。”Set-PowerPointApp=…“'将创建power point应用程序的实例。为什么要测试您是否有实例？您在评论中的响应对我来说没有多大意义。抱歉