Удаление пробелов в строках таблицы в PowerPoint с помощью макросов

Question

Я пытаюсь исправить содержание таблицы, которое превышает высоту и ширину слайда.Чтобы сделать это, я попытался уменьшить размер текста в таблице (как вы видите на рисунке, размер шрифта изменен с 9 на 9). Другой метод, который я планирую использовать, заключается в устранении лишнего «белого / пустого пространства», присутствующего вкаждый ряд таблицы уменьшением высоты (отмечен синим цветом).

Пожалуйста, помогите мне прояснить мои мысли или любую информацию, чтобы достичь этого.

image

Answer 1

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

Sub CheckTableHeight()
  Dim oSlide As Slide
  Dim oShape As Shape
  Dim oTable As Table
  Dim Row&, Column&
  For Each oSlide In ActivePresentation.Slides
    For Each oShape In oSlide.Shapes
      If oShape.HasTable Then
        Set oTable = oShape.Table
        Do Until oShape.Height + oShape.Top < ActivePresentation.PageSetup.SlideHeight
          For Row& = 1 To oTable.Rows.Count
            oTable.Rows(Row&).Height = 5
            For Column& = 1 To oTable.Columns.Count
              oTable.Cell(Row&, Column&).Shape.TextFrame2.TextRange.Font.Size = (oTable.Cell(Row&, Column&).Shape.TextFrame2.TextRange.Font.Size - 1)
            Next Column&
          Next Row&
        Loop
      End If
    Next oShape
  Next oSlide
End Sub