Coordinates of a textframe in PowerPoint via VBA - vba

Question

I want to take all the articles in Word document and transform them into PowerPoint Presentation.
1 article = 1 slide (if the text does not fit shrink it, else create a new slide).
I managed to recognize each part of the article by its Style in Word. I get text by its style and insert it into a slide and so forth. I retrieve text by paragraphs (Selection.StartOf and EndOf didn't work).
I didn't find a way to avoid overlaying one text over the other.
Maybe I can get what I need by the coordinates of the textframes?
What I have got so far:
For Each StyleInWord In ActiveDocument.Paragraphs
If StyleInWord.Style = "NAME_OF_THE_ARTICLE" Then
wordText0 = StyleInWord.Range
Set pptLayout = pptPres.SlideMaster.CustomLayouts.Add(ppLayoutBlank)
Set pptSlide = pptPres.Slides.AddSlide(1, pptLayout)
If pptPres.Slides(1).Shapes(1).HasTextFrame Then
pptPres.Slides(1).Shapes(1).Delete
End If
With pptPres.PageSetup
.SlideSize = ppSlideSizeCustom
.SlideHeight = CentimetersToPoints(21.008)
.SlideWidth = CentimetersToPoints(28.011)
End With
Set mySlide = pptPres.Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal, CentimetersToPoints(1.31), CentimetersToPoints(3.73), CentimetersToPoints(24.34), CentimetersToPoints(12.57))
With mySlide.TextFrame.TextRange
.Text = wordText0
With .Font
.Size = 11 ' points
.Name = "Arial"
.Bold = msoTrue
End With
End With
End If
If StyleInWord.Style = "DESCRIPTION_OF_THE_ARTICLE" Then
wordText1 = StyleInWord.Range
Set mySlide = pptPres.Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal, CentimetersToPoints(1.31), CentimetersToPoints(5.73), CentimetersToPoints(24.34), CentimetersToPoints(12.57))
With mySlide.TextFrame
With .TextRange
.Text = wordText1
With .Font
.Size = 11 ' points
.Name = "Arial"
.Bold = msoTrue
End With
End With
End With
End If
If StyleInWord.Style = "MAIN_TEXT_OF_THE_ARTICLE" Then
Set mySlide = pptPres.Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal, CentimetersToPoints(1.31), CentimetersToPoints(7.73), CentimetersToPoints(24.34), CentimetersToPoints(12.57))
wordText2 = StyleInWord.Range
With mySlide.TextFrame
With .TextRange
.Text = wordText2
With .Font
.Size = 11 ' points
.Name = "Arial"
.Bold = msoTrue
End With
End With
End With
End If
Next StyleInWord
'Here i change the order, so the first slide i create will stay the first by the end of the forEachLoop
i = 1
For i = 1 To pptPres.Slides.Count
pptPres.Slides(i).MoveTo 1
Next i

Answer 1

Each time you add a textbox you set the top position to simply be 2cm lower than the previous one. This takes no account of the height of the previous text box.
There is a very simple solution to this. A text box has properties for both top and height, so just store those in variables. That way you can add each new text box directly below the previous one.
Your code also needs some improvement as some of the presentation setup you are doing should be outside the loop. You should also rename mySlide as pptTextBox so that the variable has a logical name that is consistent with the others.
Set pptLayout = pptPres.SlideMaster.CustomLayouts.Add(ppLayoutBlank) doesn't do what you think it does and is unnecessary. The presentation will already contain a blank layout, helpfully named "Blank", so all you need to do is set a pointer to it, again outside the loop.
'do presentation setup outside the loop
With pptPres.PageSetup
.SlideSize = ppSlideSizeCustom
.SlideHeight = CentimetersToPoints(21.008)
.SlideWidth = CentimetersToPoints(28.011)
End With
'a presentation will already include a blank layout so there is no need to create one
For Each pptLayout In pptPres.SlideMaster.CustomLayouts
If pptLayout.Name = "Blank" Then Exit For
'pptLayout now points to the Blank layout
Next
For Each StyleInWord In ActiveDocument.Paragraphs
If StyleInWord.Style = "NAME_OF_THE_ARTICLE" Then
wordText0 = StyleInWord.Range
Set pptSlide = pptPres.Slides.AddSlide(1, pptLayout)
If pptPres.Slides(1).Shapes(1).HasTextFrame Then
pptPres.Slides(1).Shapes(1).Delete
End If
Set pptTextBox = _
pptPres.Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal, _
CentimetersToPoints(1.31), CentimetersToPoints(3.73), _
CentimetersToPoints(24.34), CentimetersToPoints(12.57))
With pptTextBox
With .TextFrame.TextRange
.Text = wordText0
With .Font
.Size = 11 ' points
.Name = "Arial"
.Bold = msoTrue
End With
End With
textBoxTop = .Top
textBoxHeight = .Height
End With
End If
If StyleInWord.Style = "DESCRIPTION_OF_THE_ARTICLE" Then
wordText1 = StyleInWord.Range
Set pptTextBox = _
pptPres.Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal, _
CentimetersToPoints(1.31), textBoxTop + textBoxHeight, _
CentimetersToPoints(24.34), CentimetersToPoints(12.57))
With pptTextBox
With .TextFrame.TextRange
.Text = wordText1
With .Font
.Size = 11 ' points
.Name = "Arial"
.Bold = msoTrue
End With
End With
textBoxHeight = textBoxHeight + .Height
End With
End If
If StyleInWord.Style = "MAIN_TEXT_OF_THE_ARTICLE" Then
Set pptTextBox = _
pptPres.Slides(1).Shapes.AddTextbox(msoTextOrientationHorizontal, _
CentimetersToPoints(1.31), textBoxTop + textBoxHeight, _
CentimetersToPoints(24.34), CentimetersToPoints(12.57))
wordText2 = StyleInWord.Range
With pptTextBox
With .TextFrame.TextRange
.Text = wordText2
With .Font
.Size = 11 ' points
.Name = "Arial"
.Bold = msoTrue
End With
End With
textBoxHeight = textBoxHeight + .Height
End With
End If
Next StyleInWord
'Here i change the order, so the first slide i create will stay the first by the end of the forEachLoop
i = 1
For i = 1 To pptPres.Slides.Count
pptPres.Slides(i).MoveTo 1
Next i