创建 PPT table 运行速度慢得无法忍受

Question

我正在使用 Excel vba 在 powerpoint 幻灯片中创建 table 并将数据导出到所述 table。这是一个基本的事件日历。 table 构建如此缓慢。它有 25 行（header + 24 小时）和 9（对于 M-F）或 11（包括周末）列，具体取决于用户点击的是 5 天按钮还是 7 天按钮。

我有 9 列版本和 11 列版本的单独订阅。两个 table 的构建速度都非常慢。专门调整行高需要这么长时间。设置行高后，table 填充速度足够快。 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

尝试隐藏 table

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 秒缩短到 ~0.3-0.4 秒

创建 PPT table 运行速度慢得无法忍受

Creating PPT table runs intolerably SLOW

excel

powerpoint

vba