Создание таблицы PPT невыносимо работает медленно

Question

Я использую Excel vba для создания таблицы в слайде PowerPoint и экспорта данных в эту таблицу. Это базовый календарь событий. Стол строится так медленно. Это 25 строк (заголовок + 24 часа) и 9 (для MF) или 11 (включая выходные) столбцов в зависимости от того, нажимает ли пользователь 5-дневную кнопку или 7-дневную кнопку. У меня есть отдельные сабвуферы для версии с 9 колонками и версии с 11 колонками. Обе таблицы строятся невероятно медленно. Требуется так много времени, чтобы настроить высоту строк. Как только высота строки установлена, таблица заполняется достаточно быстро. Код версии с 9 столбцами ниже сокращен, чтобы не включать каждый ряд времени. Есть ли способ ускорить процесс?

Sub BuildFiveDayTable()

Dim BREtable as PowerPoint.Shape

Set BREtable = NewBREslide.Shapes.AddTable(25, 9, 1, 15, 719.25, 486)       'BREtable and NewBREslide are public variables decalred as Powerpoint shape and slide respectively.
BREtable.Name = "BREtable"

BREtable.Table.ApplyStyle ("5940675A-B579-460E-94D1-54222C63F5DA")     'No Fill, Table Style

BREtable.Table.Rows(1).Height = 14.4

For i = 2 to BREtable.Table.Rows.count         'steps through each row setting height. This is what runs slow.
     BREtable.Table.Rows(i).Height = 19.44
Next i

For i = 1 To BREtable.Table.Rows.count
     For j = 1 to BREtable.Table.Columns.count
          With BREtable.Table.Cell(i,j).Shape.TextFrame
               .TextRange.ParagraphFormat.Alignment = ppAlignCenter
               .TextRange.Font.Name = "Calibri"
               .TextRange.Font.Size = 10
               .TextRange.Bold = msoTrue
               .MarginBottom = 0
               .MarginLeft = 0
               .MarginTop = 0
               .MarginRight = 0
          End With
      Next j
Next i

With BREtable.Table
     .Columns(1).Width = 28.8
     .Cell(1,1).Shape.TextFrame.TextRange.Text = "KWT"
     .Cell(1,1).Shape.Fill.Forecolor.RGB = RGB(0,0,0)
     .Cell(1,1).Shape.TextFrame.TextRange.Font.Color = RGB(255,192,0)
     .Cell(2,1).Shape.TextFrame.TextRange.Text = "0600"
     .Cell(3,1).Shape.TextFrame.TextRange.Text = "0700"
     ...
     .Cell(25,1).Shape.TextFrame.TextRange.Text = "0500"

     .Columns(2).Width = 28.8
     .Cell(1,2).Shape.TextFrame.TextRange.Text = "GMT"
     .Cell(1,2).Shape.Fill.Forecolor.RGB = RGB(255,192,0)
     .Cell(1,2).Shape.TextFrame.TextRange.Font.Color = RGB(0,0,0)
     .Cell(2,2).Shape.TextFrame.TextRange.Text = "0400"
     .Cell(3,2).Shape.TextFrame.TextRange.Text = "0500"
     ...
     .Cell(25,2).Shape.TextFrame.TextRange.Text = "0300"

     .Columns(3).Width = 28.8
     .Cell(1,3).Shape.TextFrame.TextRange.Text = "EDT"
     .Cell(1,3).Shape.Fill.Forecolor.RGB = RGB(0,0,0)
     .Cell(1,3).Shape.TextFrame.TextRange.Font.Color = RGB(255,192,0)
     .Cell(2,3).Shape.TextFrame.TextRange.Text = "2300"
     .Cell(3,3).Shape.TextFrame.TextRange.Text = "0000"
     ...
     .Cell(25,3).Shape.TextFrame.TextRange.Text = "2200"

     .Columns(4).Width = 120.6
     .Cell(1,4).Shape.TextFrame.TextRange.Text = "Mon"
     .Cell(1,4).Shape.Fill.ForeColor.RGB = RGB(242,242,242)
     .Cell(1,4).Shape.TextFrame.TextRange.Fond.Color = RGB(0,0,0)

     .Columns(5).Width = 120.6
     .Cell(1,5).Shape.TextFrame.TextRange.Text = "Tues"
     .Cell(1,5).Shape.Fill.ForeColor.RGB = RGB(242,242,242)
     .Cell(1,5).Shape.TextFrame.TextRange.Fond.Color = RGB(0,0,0)

     .Columns(6).Width = 120.6
     .Cell(1,6).Shape.TextFrame.TextRange.Text = "Wed"
     .Cell(1,6).Shape.Fill.ForeColor.RGB = RGB(242,242,242)
     .Cell(1,6).Shape.TextFrame.TextRange.Fond.Color = RGB(0,0,0)

     .Columns(7).Width = 120.6
     .Cell(1,7).Shape.TextFrame.TextRange.Text = "Thurs"
     .Cell(1,7).Shape.Fill.ForeColor.RGB = RGB(242,242,242)
     .Cell(1,7).Shape.TextFrame.TextRange.Fond.Color = RGB(0,0,0)

     .Columns(8).Width = 120.6
     .Cell(1,8).Shape.TextFrame.TextRange.Text = "Fri"
     .Cell(1,8).Shape.Fill.ForeColor.RGB = RGB(242,242,242)
     .Cell(1,8).Shape.TextFrame.TextRange.Fond.Color = RGB(0,0,0)

     .Columns(9).Width = 28.8
     'Repeat Column 3
End With
End Sub

Answer 1

Попробуйте скрыть таблицу

Dim t
'.....
BREtable.Visible = False
t = Timer
For i = 2 To BREtable.Table.Rows.Count
     BREtable.Table.Rows(i).Height = 19.44
Next i
BREtable.Visible = True
Debug.Print Timer - t
'.....

В моих быстрых тестах это изменение выполнения среза блока с ~ 1,3 сек c до ~ 0,3-0,4 сек c