Powerpoint VBA自动化在Excel中运行时速度较慢
我正在使用一个excelmacros在幻灯片上build立一个表格，并且通过单元格迭代非常慢（每个单元格大概需要1-2秒）。 有没有办法让这个过程更快？ 这是我的代码：
Private Function formatTable(shp As PowerPoint.Shape) Dim i As Byte Dim j As Byte Dim k As Byte Dim tabCol As Byte With shp.Table tabCol = .Columns.Count For i = 1 To .Rows.Count For j = 1 To tabCol With .Cell(i, j).Shape .TextFrame2.TextRange.Font.Bold = msoTrue Select Case i Case 1 ' Header Row .Fill.ForeColor.RGB = RGB(128, 128, 128) Case 2, 6, 10, 14, 19 'Elements .Fill.ForeColor.RGB = RGB(192, 192, 192) Case 23 'Satisfaction .Fill.ForeColor.RGB = RGB(255, 255, 153) Case 27, 29, 31 'Future Behaviors .Fill.ForeColor.RGB = RGB(204, 255, 104) Case Else .Fill.ForeColor.RGB = RGB(255, 255, 255) .TextFrame2.TextRange.Font.Bold = msoFalse End Select With .TextFrame2.TextRange.Font .Name = "Arial" .Fill.ForeColor.RGB = IIf(i = 1, vbWhite, vbBlack) .Size = IIf(j <> 1 And i = 1, 7, 8) End With .TextFrame.TextRange.ParagraphFormat.Alignment = IIf(j = 1, ppAlignLeft, ppAlignCenter) End With With .Cell(i, j) .Borders(ppBorderBottom).Weight = 1 .Borders(ppBorderTop).Weight = 1 .Borders(ppBorderLeft).Weight = 1 .Borders(ppBorderRight).Weight = 1 End With Next Next End With End Function 不幸的是，这是我知道将表格中的单元格着色的唯一方法。 即通过循环。 但是，你可以大大减less时间:)
你注意到Case Else部分吗？ 这是表格的大部分。 所以你实际上可以从代码中删除它，并使用下面的代码一次性为整个表着色
oPPSlide.Shapes(1).Table.Background.Fill.ForeColor.RGB = RGB(255, 255, 255)
您可以删除Case Else部分。 所以你将不得不less循环。 事实上，这将大大缩短整体时间。 看到我创build的这个例子。
Sub Sample() Dim oPPApp As New PowerPoint.Application Dim oPPPrsn As PowerPoint.Presentation Dim oPPSlide As PowerPoint.Slide Dim FlName As String '~~> Change this to the relevant file FlName = "C:\Users\Siddharth Rout\Documents\MyFile.PPTX" oPPApp.Visible = True '~~> Open the relevant powerpoint file Set oPPPrsn = oPPApp.Presentations.Open(FlName) '~~> Change this to the relevant slide which has the shape Set oPPSlide = oPPPrsn.Slides(1) '~~> Change the background of the table in one go oPPSlide.Shapes(1).Table.Background.Fill.ForeColor.RGB = RGB(255, 255, 255) formatTable oPPSlide.Shapes(1) ' '~~> Rest of the code ' End Sub Private Function formatTable(shp As PowerPoint.Shape) Dim i As Long, j As Long, k As Long, tabCol As Long With shp.Table tabCol = .Columns.Count For i = 1 To .Rows.Count For j = 1 To tabCol With .Cell(i, j).Shape .TextFrame2.TextRange.Font.Bold = msoTrue Select Case i Case 1: .Fill.ForeColor.RGB = RGB(128, 128, 128) Case 2, 6, 10, 14, 19: .Fill.ForeColor.RGB = RGB(192, 192, 192) Case 23: .Fill.ForeColor.RGB = RGB(255, 255, 153) Case 27, 29, 31: .Fill.ForeColor.RGB = RGB(204, 255, 104) ' Case Else ' .Fill.ForeColor.RGB = RGB(255, 255, 255) ' .TextFrame2.TextRange.Font.Bold = msoFalse End Select With .TextFrame2.TextRange.Font .Name = "Arial" .Fill.ForeColor.RGB = IIf(i = 1, vbWhite, vbBlack) .Size = IIf(j <> 1 And i = 1, 7, 8) End With .TextFrame.TextRange.ParagraphFormat.Alignment = IIf(j = 1, 1, 2) End With With .Cell(i, j) .Borders(ppBorderBottom).Weight = 1 .Borders(ppBorderTop).Weight = 1 .Borders(ppBorderLeft).Weight = 1 .Borders(ppBorderRight).Weight = 1 End With Next Next End With End Function