Autumatic content list creation

[rmodin]

Hi!

I work on a VBA script, that runs through all slides of a Powerpoint presentation, checks the distanse of every shape to the top and to the left edges of the slide. For every shape that is close enough to both the top and the left the script takes the text content and appends it to the text of a shape 1 on slide 1.
But it works in a wrong way: it runs through a right shape without appending it's text content.

Here is the script:

Sub ListOfContent()
i = 0

For Each Sld In ActivePresentation.Slides
i = i + 1
For Each Sh In Sld.Shapes
If Sh.TextFrame.HasText() And Sh.Top < 20 And Sh.Left < 20 Then
ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange.InsertAfter (vbCrLf&Sh.TextFrame.TextRange.Text)
End If
Next
Next
End Sub

[John Wilson]

Sub makeContents()Dim oshp As Shape
Dim i As Integer
For i = 2 To ActivePresentation.Slides.Count
For Each oshp In ActivePresentation.Slides(i).Shapes
If oshp.HasTextFrame Then
If oshp.TextFrame.HasText _
And oshp.Top < 20 _
And oshp.Left < 20 Then
ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange = _
ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange & oshp.TextFrame.TextRange & vbCrLf
End If
End If
Next oshp
Next i
End Sub

BUT are you sure the "Title" shapes are really < 20 from Top & Left?

If they are real Title placeholders there are easier way to find them

[rmodin]

BUT are you sure the "Title" shapes are really < 20 from Top & Left?

If they are real Title placeholders there are easier way to find them
This is a document, designed for some special purpose report. The real Title placeholders are not "Title" shapes. Actually, after running your script I have found that Titles are single cell tables at the top left slide corner. I had to make additional changes in the code, and now it works well. I'll put some effort in optimising the output, and the work is done!

Thank you for help, John!

[John Wilson]

Should probably look like this:


Sub makeContents()Dim oshp As Shape
Dim i As Integer
For i = 2 To ActivePresentation.Slides.Count
For Each oshp In ActivePresentation.Slides(i).Shapes
If oshp.HasTable And oshp.Top < 20 _
And oshp.Left < 20 Then
ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange = _
ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange _
& oshp.Table.Cell(1, 1).Shape.TextFrame.TextRange & vbCrLf
End If
Next oshp
Next i
End Sub

[rmodin]

Yes, it looks like this, except that I used

Colomns(1).Cells(1)

as a reference to the cell. Is it OK?


And I have another question. Is it possible to export content in an Excel file instead of making on a slide shape?
Maybe, it's reasonable to write a script in an Excel file, not Powerpoint. Then it will be possible to syncronize slide titles witn the content table in Excel.

[John Wilson]

Colomns(1).Cells(1)

Is the same as Cell(1,1) Well it is if you mean ColUmns!

Cell(1,1) is Row 1, Column 1