Блог

Я использую VBA для создания таблицы с очень специфическим форматированием. По какой-то причине добавление таблицы размером 10×18 занимает около 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
  

Я устанавливаю некоторую ширину столбцов с жесткими значениями. Я знаю, что это некрасиво, но пока сойдет.