使用VBA格式化PowerPoint表非常慢

Question

我正在使用VBA创建具有非常特定格式的表。由于某种原因，添加10x18表格大约需要10秒钟。这似乎过长，但我无法找到原因。关于如何加快速度的任何想法？

我认为这可能与PowerPoint尝试呈现每个更改有关。我希望能够只创建表，然后才能显示它。

Public Sub format_planning_table(tbl As Table, isNew As Boolean)
    Dim row, col As Integer

    'First do default formatting so we don't have to change everything
    format_table tbl, isNew, 11

    With tbl

        .Cell(1, 1).Shape.Fill.Transparency = 0
        .Cell(1, 1).Shape.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent2

        'Set column widths
        .Columns(1).width = 130.1576
        .Columns(2).width = 137.4546
        .Columns(3).width = 53.09087
        For col = 4 To .Columns.Count
            .Columns(col).width = 38.31606
        Next col

        'Set height for top two rows
        .Rows(1).height = 20.4
        .Rows(2).height = 20.4
        For col = 1 To .Columns.Count
            'Format top row (some merged cells)
            .Cell(1, col).Shape.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent5
            .Cell(2, col).Shape.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent5
            .Cell(1, col).Shape.TextFrame.VerticalAnchor = msoAnchorMiddle 'Vertical alignment to middle
            .Cell(2, col).Shape.TextFrame.VerticalAnchor = msoAnchorMiddle 'Vertical alignment to middle
            .Cell(2, col).Shape.TextFrame.TextRange.Font.Color.ObjectThemeColor = msoThemeColorLight1
            .Cell(2, col).Shape.TextFrame.TextRange.Font.Bold = msoTrue

            'Weeks
            If col >= 4 Then
                .Cell(1, col).Shape.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter 'Horizontal alignment center
                .Cell(2, col).Shape.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter 'Horizontal alignment center

                'Set alternating shading. 1 is gray, 0 is white
                For row = 3 To .Rows.Count
                    If .Cell(3, col).Shape.TextFrame.TextRange.Text = "@@1" Then
                        .Cell(row, col).Shape.Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1
                    End If
                    .Rows(row).Cells.Borders(ppBorderLeft).Transparency = 1 'Remove border.

                Next row
                .Cell(3, col).Shape.TextFrame.TextRange.Text = "" 'Empty the temporary text

            End If
        Next col

        'For the data part, set the bottom border for the entire row, then reset for first two columns
        For row = 3 To .Rows.Count
            .Cell(row, 1).Shape.TextFrame.TextRange.Font.Color.ObjectThemeColor = msoThemeColorLight1
            .Cell(row, 2).Shape.TextFrame.TextRange.Font.Color.ObjectThemeColor = msoThemeColorLight1
            With .Rows(row).Cells.Borders(ppBorderBottom)
                .DashStyle = 11
                .Weight = 1.5
                .ForeColor.ObjectThemeColor = msoThemeColorText1
            End With
            With .Cell(row, 1).Borders(ppBorderBottom) 'Reset first column
                .DashStyle = msoLineSolid
                .Weight = 2.25
                .ForeColor.ObjectThemeColor = msoThemeColorLight1
            End With
            With .Cell(row, 2).Borders(ppBorderBottom) 'Reset second column
                .DashStyle = msoLineSolid
                .Weight = 2.25
                .ForeColor.ObjectThemeColor = msoThemeColorLight1
            End With
        Next row
    End With
End Sub

我正在使用硬值设置某些列宽。我知道这很丑，但是现在就可以了。