#vba #powerpoint
#vba #powerpoint
Вопрос:
Я использую 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
Я устанавливаю некоторую ширину столбцов с жесткими значениями. Я знаю, что это некрасиво, но пока сойдет.
Комментарии:
1. Для меня это выполняется достаточно быстро, сколько времени занимает format_table? Вы могли бы поработать с
FirstRow
,LastCol
и т.д., Чтобы немного улучшить это. Вы могли бы рассмотреть возможность создания скрытого слайда с уже созданной пустой таблицей, которую вы могли бы просто скопировать, когда вам понадобится новая.2. Для таблицы размером 10×18 оба
format_table
иformat_planning_table
занимают около 10 секунд (хотя это включает время на создание таблицы в первую очередь). Мне нравится идея подготовить пустую (отформатированную) таблицу и просто скопировать ее.3. Я полагаю, вы могли бы также рассмотреть возможность начать с таблицы, содержащей всего 2 или 3 строки, отформатировать ее (с помощью полосатых строк), а затем, в конечном итоге, добавить к ней еще несколько строк. Я бы сначала скопировал.