通过 VBA 在 PowerPoint 中的文本框坐标

Question

我想把 Word 文档中的所有文章转换成 PowerPoint 演示文稿。
1 篇文章 = 1 张幻灯片（如果文本不适合缩小，则创建新幻灯片）。

我设法通过 Word 中的样式识别了文章的每个部分。我通过其样式获取文本并将其插入幻灯片等。我按段落检索文本（Selection.StartOf 和 EndOf 不起作用）。

我没有找到避免将一个文本覆盖在另一个文本上的方法。

也许我可以通过文本框的坐标得到我需要的东西？

到目前为止我得到了什么：

     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

每次添加文本框时，您都会将顶部位置设置为比前一个位置低 2 厘米。这不考虑前一个文本框的高度。

有一个非常简单的解决方案。文本框具有顶部和高度的属性，因此只需将它们存储在变量中即可。这样您就可以在前一个文本框的正下方添加每个新文本框。

您的代码还需要一些改进，因为您正在进行的一些演示设置应该在循环之外。您还应该将 mySlide 重命名为 pptTextBox，以便该变量具有与其他变量一致的逻辑名称。

Set pptLayout = pptPres.SlideMaster.CustomLayouts.Add(ppLayoutBlank) 没有做你认为它做的事情，而且是不必要的。演示文稿已经包含一个空白布局，名为“Blank”，因此您需要做的就是在循环之外再次设置一个指向它的指针。

   '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