Question

У меня есть макрос, настроенный для автоматизации создания ppt.Также я настроил объект пользовательских коллекций для хранения различных «продуктов» и соответствующих графиков.Имея это в виду, я хотел создать цикл For Each в пользовательской коллекции для итерации по каждому продукту и создать презентацию PPT с интервалом (3 * i + 1) на слайдах ppt.например,

For I = 0 to slides.count

            ‘slides(3*i) to write to the first page
            ‘slides(3*I + 1) to write to the second page
            ‘slides(3*I + 2) to write to the third page

Next i

Код, который у меня есть, может создать первый элемент в коллекции без проблем, к сожалению, у меня не получилось настроить цикл для итерации по коллекции.

вот где я сейчас нахожусь:

В идеале, я хотел бы также хранить данные о ширине / высоте и форматировании в коллекции, но по одной проблеме за раз!

Любая помощь будет принята с благодарностью!

Sub test2()

Dim Mypath As String
Dim Myname As String
Dim myTitle As String
Dim shapeCount As Integer

Dim PPT As Object
Set PPT = CreateObject("PowerPoint.Application")


Myname = ThisWorkbook.Name
Mypath = ThisWorkbook.Path


PPT.Visible = True
PPT.Presentations.Open Filename:=Mypath & "\XXXX - 
Template.pptx"

Dim shP As Object
Dim myShape As Object
Dim mySlide As Object
Dim tempSize As Integer, tempFont As String


Dim Funds As Collection
Dim V As Fund

Set V = New Fund
Set Funds = New Collection

Dim FundID As String
Dim Title As Range
Dim Fund_MER As String
Dim Fund_Yield As String
Dim Asset_Alloc As String
Dim Asset_Alloc2 As String
Dim Asset_Alloc3 As String
Dim Asset_Alloc4 As String
Dim Title_2 As String
Dim Trailing As String
Dim Calendar As String


V.FundID = "V1"
V.Title = "Profile_FactSheet_Title_En"
V.Fund_MER = "V1_MER"
V.Fund_Yield = "V1_Yield"
V.Asset_Alloc = "V1_assetAlloc_En_SourceData"
V.Asset_Alloc2 = "AAV1EN"
V.Asset_Alloc3 = "FIV1EN"
V.Asset_Alloc4 = "FIMAV1EN"
V.Title_2 = "Profile_FactSheet_Title_En"
V.Trailing = "RetV1TrailingEN"
V.Calendar = "RetV1CalendarEN"


Funds.Add V, V.FundID

V.FundID = "V2"
V.Title = "Profile_FactSheet_Title_En"
V.Fund_MER = "V2_MER"
V.Fund_Yield = "V2_YIELD"
V.Asset_Alloc = "V2_assetAlloc_En_SourceData"
V.Asset_Alloc2 = "AAV2EN"
V.Asset_Alloc3 = "FIV2EN"
V.Asset_Alloc4 = "EQSECV2EN"
V.Title_2 = "Profile_FactSheet_Title_En"
V.Trailing = "RetV2TrailingEN"
V.Calendar = "RetV2CalendarEN"


Funds.Add V, V.FundID

Worksheets("Profile Fact Sheet Tables EN").Activate

'select the name of report
Set shP = Range(V.Title)

'select the ppt sheet you wish to copy the object to
Set mySlide = PPT.ActivePresentation.slides(1)

'count the number of shapes currently on the PPT
shapeCount = mySlide.Shapes.Count
'copy the previously selected shape
shP.Copy
'paste it on the PPT
mySlide.Shapes.Paste

'wait until the count of shapes on the PPT increases, which signals that the past operation is finished.
Do '<~~ wait completion of paste operation
    DoEvents
Loop Until mySlide.Shapes.Count > shapeCount

'adjust formatting of the newly copied shape: position on the sheet, font & size
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

    myShape.Left = 254.016
    myShape.Top = 42.8085
    myShape.Width = 286.0515
    myShape.Height = 46.7775
    myShape.TextEffect.FontSize = 15
    myShape.TextEffect.FontName = "Century Schoolbook"


'activate the sheet containing the charts.
Worksheets("Profile Fact Sheet Tables EN").Activate


'copy mer data object
Set shP = Range(V.Fund_MER)

'switch to slide
Set mySlide = PPT.ActivePresentation.slides(1)

'count the current number of shapes
shapeCount = mySlide.Shapes.Count

'copy and paste previously selected shape
shP.Copy
mySlide.Shapes.Paste

'wait until the number of shapes on the ppt changes.
Do '<~~ wait completion of paste operation
    DoEvents
Loop Until mySlide.Shapes.Count > shapeCount

'adjust the formatting of the shape.
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

    myShape.Left = 210.357
    myShape.Top = 149.121
    myShape.TextEffect.FontSize = 10
    myShape.TextEffect.FontName = "Calibri (Corps)"

Set shP = Range(V.Fund_Yield)

shapeCount = mySlide.Shapes.Count
shP.Copy
mySlide.Shapes.Paste

Do '<~~ wait completion of paste operation
    DoEvents
Loop Until mySlide.Shapes.Count > shapeCount

Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

    myShape.Left = 210.357
    myShape.Top = 164.43
    myShape.TextEffect.FontSize = 10
    myShape.TextEffect.FontName = "Calibri (Corps)"

mySlide.ActiveWindow.Selection.Unselect


Set shP = Range(V.Asset_Alloc) 'Range("V1_assetAlloc_En_SourceData")

Set mySlide = PPT.ActivePresentation.slides(1) '1

shapeCount = mySlide.Shapes.Count
shP.Copy
mySlide.Shapes.Paste

Do '<~~ wait completion of paste operation
    DoEvents
Loop Until mySlide.Shapes.Count > shapeCount

Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

    myShape.Left = 265.923
    myShape.Top = 124.74
    myShape.Width = 259.4025


Worksheets("Profile Fact Sheet Tables EN").Activate

Set shP = ActiveSheet.Shapes(V.Asset_Alloc2)
Set mySlide = PPT.ActivePresentation.slides(1)

shapeCount = mySlide.Shapes.Count
shP.Copy
mySlide.Shapes.Paste

Do '<~~ wait completion of paste operation
    DoEvents
Loop Until mySlide.Shapes.Count > shapeCount


Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

    myShape.Left = 62.937
    myShape.Top = 246.3615


Worksheets("Profile Fact Sheet Tables EN").Activate

Set shP = ActiveSheet.Shapes(V.Asset_Alloc3)
Set mySlide = PPT.ActivePresentation.slides(1)

shapeCount = mySlide.Shapes.Count
shP.Copy
mySlide.Shapes.Paste

Do '<~~ wait completion of paste operation
    DoEvents
Loop Until mySlide.Shapes.Count > shapeCount

Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

    myShape.Left = 28.0665
    myShape.Top = 450.765

Worksheets("Profile Fact Sheet Tables EN").Activate

Set shP = ActiveSheet.Shapes(V.Asset_Alloc4)
Set mySlide = PPT.ActivePresentation.slides(1)

shapeCount = mySlide.Shapes.Count
shP.Copy
mySlide.Shapes.Paste

Do '<~~ wait completion of paste operation
    DoEvents
Loop Until mySlide.Shapes.Count > shapeCount

Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

    myShape.Left = 265.6395
    myShape.Top = 481.0995

Worksheets("Profile Fact Sheet Tables EN").Activate

Set shP = Range(V.Title_2) 'Cells(1, 2)

Set mySlide = PPT.ActivePresentation.slides(1)

shapeCount = mySlide.Shapes.Count
shP.Copy
mySlide.Shapes.Paste

Do '<~~ wait completion of paste operation
    DoEvents
Loop Until mySlide.Shapes.Count > shapeCount


Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

    myShape.Left = 254.016
    myShape.Top = 42.8085
    myShape.Width = 286.0515
    myShape.Height = 46.7775
    myShape.TextEffect.FontSize = 15
    myShape.TextEffect.FontName = "Century Schoolbook"

Worksheets("Perf Tables 1859").Activate


Set shP = ActiveSheet.Shapes(V.Trailing)
Set mySlide = PPT.ActivePresentation.slides(2)

shapeCount = mySlide.Shapes.Count
shP.Copy
mySlide.Shapes.Paste

Do '<~~ wait completion of paste operation
    DoEvents
Loop Until mySlide.Shapes.Count > shapeCount

Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

    myShape.Left = 33.453
    myShape.Top = 155.925

Worksheets("Perf Tables 1859").Activate

Set shP = ActiveSheet.Shapes(V.Calendar)
Set mySlide = PPT.ActivePresentation.slides(2)

shapeCount = mySlide.Shapes.Count
shP.Copy
mySlide.Shapes.Paste

Do '<~~ wait completion of paste operation
    DoEvents
Loop Until mySlide.Shapes.Count > shapeCount

Set myShape = mySlide.Shapes(mySlide.Shapes.Count)

    myShape.Left = 33.453
    myShape.Top = 372.519
Next

End Sub

Jens.Huehn_at_SlideFab.com · Answer 1 · 14 ноября 2018

только что посмотрел ваш код.Если я правильно понял вашу проблему, то вы хотите создать цикл, создающий все эти 8 слайдов или около того, и спросите, откуда взять параметры, такие как высота или ширина.Если это понимание верно, вы можете создать таблицу в Excel для управления своей автоматизацией.Преимущество состоит в том, что если что-то меняется, код не нужно менять: вам просто нужно обновить контрольную таблицу.В этой таблице могут быть следующие столбцы:

Исходный лист
Исходный диапазон
Целевой слайд №
Ширина целевой фигуры
Высота формы цели
Верх формы цели
Форма слева цели
Имя шрифта формы цели
Размер шрифта формы цели

Затем ваш макрос должен перебирать каждую строку и считывать значения, чтобы правильно расположить и отформатировать Powerpoint.Чтобы сохранить ваш код чистым и многократно используемым, вы должны попытаться обернуть вещи в функции, например, функцию для копирования, вставки и настройки формы на основе параметров, как указано в таблице выше.

В случаевам просто нужно что-то, что работает, вы также можете попробовать (мое программное обеспечение) SlideFab.com , которое бесплатно, если не более двух элементов (например, фигуры, диаграммы, таблицы и т. д.) на слайдскопировал из Excel в Powerpoint (так что он должен работать у вас, я думаю).Тогда вам вообще не нужно кодировать.

Приветствия

Дженс

Макрос VBA Для создания презентации PPT

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Макрос VBA Для создания презентации PPT

Пожалуйста, войдите или зарегистрируйтесь чтобы ответить на этот вопрос.

1 Ответ

Пожалуйста, войдите или зарегистрируйтесь что бы добавить комментарий.

Нет похожих вопросов