Pfthb

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