Динамический массив из Excel в PPT - PullRequest
Новая
       12

Динамический массив из Excel в PPT

0 голосов
/ 06 октября 2019

У меня есть код 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, поэтому, когда я ссылаюсь на массив, он должен захватывать диапазон отчетов

Ex

enter image description here

Как построить динамический диапазон?

ub copiSylwadau ()

'НАЗНАЧЕНИЕ: Скопируйте диапазоны Excel и вставьте их в активные слайды презентации PowerPoint. ИСТОЧНИК: www.TheSpreadsheetGuru.com

Dim myPresentation как объект Dim mySlide как объект Dim PowerPointApp как объект Dim shp как объект Dim MySlideArray как вариант Dim MyRangeArray как вариант Dim x как длинный Dim MyArray как вариант Dim iCounter как целое число

'Создание экземпляра 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 = Worksheets ("control"). Range ("rng") "MsgBox" MyArray "MySlideArray = Array (5,7, 9, 11, 13, 15, 17, 18, 20, 22, 24, 26, 27, 28, 31)

'Список диапазонов Excel для копирования из MyRangeArray = Array (Sheet4.Range («A1: A12»), Sheet9.Range («A1: A12»), Sheet10.Range («A1: A12»), 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"))

'Циклический просмотр данных массива для x = LBound (MySlideArray) К UBound (MySlideArray)' Копировать диапазон Excel MyRangeArray (x) .Copy 'Если iCounter = iCounter <2 Затем </p> 

    '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

'Передать завершенное приложение.CutCopyMode = False ThisWorkbook.Activate MsgBox "Cyflwyniad PowerPoiНТ ВЕДИ ЕС ГРЕУ! "

End Sub

1 Ответ

0 голосов
/ 06 октября 2019

Предложите вам создать именованные диапазоны напрямую, а затем обратиться к тем в вашем коде. Пример: используйте имя «Sheet4Range» для имени Sheet4.Range («A10: AS69»). В вашем коде: 

Sheet4.Range("Sheet4Range")

Вы можете сделать определение фактического диапазона Sheet4Range динамическим именованным диапазоном (DNR). ,Есть много ресурсов, чтобы узнать, как создать DNR. Вот один из них: https://www.excel -easy.com / examples / dynamic-named-range.html

...