Vfrdtyky

I have a macro set up to automate the creation of a ppt. As well ive set up a custom collections object to store the different "products" and their respective charts. With this in mind, i wanted to create a For Each loop within the custom collection to iterate over each product, and create the PPT presentation, with a (3*i+1) interval on the ppt slides. such as

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

The code i have so far can produce the first item in the collection no problem, unfortunately ive been unsucceful in setting up the loop to iterate over the collection.

here is where i am now:

Ideally, i'd like to store also the width/height and formatting details within the collection as well, but one issue at a time !

Any help would be greatly appreciated!!

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

just looked at your code. If I get your issue right, then you want to create a loop creating all these 8 slides or so and you ask where to get the parameters like height or width from.
If this understanding is correct, you could create a table in Excel to manage your automation. The benefit is that if something changes, no code has to be changed: You just need to update the control table. This table could have the following columns:

• Source sheet


• Source range


• Target slide no


• Target shape width


• Target shape height


• Target shape top


• Target shape left


• Target shape font name


• Target shape font size

Then your macro needs to iterate over each row and read out the values in order to position and format your Powerpoint correctly. In order to keep your code clean and reusable you should try to wrap things up in functions, e.g. a function for copying, pasting and setting up a shape based with the parameters as mentioned in the table above.

In case you just need something which is working, you can also try (my software) SlideFab.com which is free as long as not more than two elements (e.g. shape, chart, table, etc.) per slide is copied from Excel to Powerpoint (so it should work for you, I guess). Then you don't need to code at all.

Cheers

Jens