Блог

Главная - Вопросы по программированию - Координаты текстового фрейма в PowerPoint через VBA

Координаты текстового фрейма в PowerPoint через VBA

#vba #ms-word #powerpoint

#vba #ms-word #powerpoint

Вопрос:

Я хочу взять все статьи в документе Word и преобразовать их в презентацию PowerPoint.
1 статья = 1 слайд (если текст не помещается, уменьшите его, иначе создайте новый слайд).

Мне удалось распознать каждую часть статьи по ее стилю в Word. Я получаю текст по его стилю и вставляю его в слайд и так далее. Я извлекаю текст по абзацам (выделение.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

Ответ №1:

Каждый раз, когда вы добавляете текстовое поле, вы устанавливаете верхнюю позицию просто на 2 см ниже предыдущей. При этом не учитывается высота предыдущего текстового поля.

Для этого есть очень простое решение. Текстовое поле имеет свойства как для вершины, так и для высоты, поэтому просто сохраните их в переменных. Таким образом, вы можете добавлять каждое новое текстовое поле непосредственно под предыдущим.

Ваш код также нуждается в некотором улучшении, поскольку некоторые настройки презентации, которые вы выполняете, должны быть вне цикла. Вы также должны переименовать mySlide как pptTextBox , чтобы переменная имела логическое имя, которое согласуется с другими.

Set pptLayout = pptPres.SlideMaster.CustomLayouts.Add(ppLayoutBlank) не делает того, что вы думаете, и в этом нет необходимости. Презентация уже будет содержать пустой макет, услужливо названный «Пустой», поэтому все, что вам нужно сделать, это установить на него указатель, опять же вне цикла.

    '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

Комментарии:

1. это действительно очень помогло. Спасибо за комментарии о «Code Tone», я пришел из сферы автоматизации, многому нужно научиться. Большое вам спасибо!

2. Также мне было интересно. Теперь с помощью этого кода выше a я получаю все нужные мне абзацы, но я также копирую символ «Enter», который появляется в презентации в виде пустой строки, есть мысли о том, как избавиться от этого?

3. @TahirRuzbaev — сразу после назначения текста строке сократите строку на один символ, например wordText0 = Left(wordText0, Len(wordText0) - 1)

4. Это тоже сработало, спасибо @Timothy Rylatt. Возможно, вы можете помочь мне с другой логикой этой программы. Теперь мне нужно уменьшить текст, если он не помещается на слайд (что я могу сделать, однако применимо для всего слайда, мне это нужно только для основного текста) Я подумал о добавлении тега к каждому абзацу основного текста и попытке работы с ним. Но, может быть, кто-нибудь может предложить другой способ?

5. @TahirRuzbaev — вам нужно опубликовать это как новый вопрос.