CODEWITHSUNDEEP
vbams-wordpowerpoint
Tahir Ruzbaev
Tahir Ruzbaev

Reputation: 49

Coordinates of a textframe in PowerPoint via VBA

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

Upvotes: 0

Views: 335

Answers (1)

Timothy Rylatt
Timothy Rylatt

Reputation: 7850

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

Upvotes: 1

Related Questions