优化 WORD VBA - If、Case

优化 WORD VBA - If、Case

我实现了下面的代码,通过 11 个下拉内容控件根据用户输入(红色、黄色、绿色和无输入)为 WORD 表中的 2 个单元格着色。

这似乎会大大减慢文档的加载速度 - 有没有办法优化代码或仅在文档关闭后计算?理想情况下,这将是第一个选择。

Option Explicit

Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
    If ContentControl.Tag = "status_1" Then
    Select Case ContentControl.Range.Text
    Case "GREEN"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
         ActiveDocument.Tables(2).Tables(1).Cell(2, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
    Case "YELLOW"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
        ActiveDocument.Tables(2).Tables(1).Cell(2, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
    Case "RED"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
        ActiveDocument.Tables(2).Tables(1).Cell(2, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
    Case Else
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
        ActiveDocument.Tables(2).Tables(1).Cell(2, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
        
        End Select
        End If
        
         If ContentControl.Tag = "status_2" Then
    Select Case ContentControl.Range.Text
    Case "GREEN"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
         ActiveDocument.Tables(2).Tables(1).Cell(3, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
    Case "YELLOW"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
        ActiveDocument.Tables(2).Tables(1).Cell(3, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
    Case "RED"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
        ActiveDocument.Tables(2).Tables(1).Cell(3, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
    Case Else
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
        ActiveDocument.Tables(2).Tables(1).Cell(3, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
        
        End Select
        End If
        
         If ContentControl.Tag = "status_3" Then
    Select Case ContentControl.Range.Text
    Case "GREEN"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
         ActiveDocument.Tables(2).Tables(1).Cell(4, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
    Case "YELLOW"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
        ActiveDocument.Tables(2).Tables(1).Cell(4, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
    Case "RED"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
        ActiveDocument.Tables(2).Tables(1).Cell(4, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
    Case Else
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
        ActiveDocument.Tables(2).Tables(1).Cell(4, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
        
        End Select
        End If
    
         If ContentControl.Tag = "status_4" Then
    Select Case ContentControl.Range.Text
    Case "GREEN"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
         ActiveDocument.Tables(2).Tables(1).Cell(5, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
    Case "YELLOW"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
        ActiveDocument.Tables(2).Tables(1).Cell(5, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
    Case "RED"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
        ActiveDocument.Tables(2).Tables(1).Cell(5, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
    Case Else
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
        ActiveDocument.Tables(2).Tables(1).Cell(5, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
        
        End Select
        End If
        
            If ContentControl.Tag = "status_5" Then
    Select Case ContentControl.Range.Text
    Case "GREEN"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
         ActiveDocument.Tables(2).Tables(1).Cell(6, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
    Case "YELLOW"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
        ActiveDocument.Tables(2).Tables(1).Cell(6, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
    Case "RED"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
        ActiveDocument.Tables(2).Tables(1).Cell(6, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
    Case Else
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
        ActiveDocument.Tables(2).Tables(1).Cell(6, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
        
        End Select
        End If
        
            If ContentControl.Tag = "status_6" Then
    Select Case ContentControl.Range.Text
    Case "GREEN"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
         ActiveDocument.Tables(2).Tables(1).Cell(7, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
    Case "YELLOW"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
        ActiveDocument.Tables(2).Tables(1).Cell(7, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
    Case "RED"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
        ActiveDocument.Tables(2).Tables(1).Cell(7, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
    Case Else
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
        ActiveDocument.Tables(2).Tables(1).Cell(7, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
        
        End Select
        End If
        
                 If ContentControl.Tag = "status_7" Then
    Select Case ContentControl.Range.Text
    Case "GREEN"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
         ActiveDocument.Tables(2).Tables(3).Cell(2, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
    Case "YELLOW"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
        ActiveDocument.Tables(2).Tables(3).Cell(2, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
    Case "RED"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
        ActiveDocument.Tables(2).Tables(3).Cell(2, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
    Case Else
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
        ActiveDocument.Tables(2).Tables(3).Cell(2, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
        
        End Select
        End If
        
                         If ContentControl.Tag = "status_8" Then
    Select Case ContentControl.Range.Text
    Case "GREEN"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
         ActiveDocument.Tables(2).Tables(3).Cell(3, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
    Case "YELLOW"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
        ActiveDocument.Tables(2).Tables(3).Cell(3, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
    Case "RED"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
        ActiveDocument.Tables(2).Tables(3).Cell(3, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
    Case Else
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
        ActiveDocument.Tables(2).Tables(3).Cell(3, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
        
        End Select
        End If
        
                              If ContentControl.Tag = "status_9" Then
    Select Case ContentControl.Range.Text
    Case "GREEN"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
         ActiveDocument.Tables(2).Tables(3).Cell(4, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
    Case "YELLOW"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
        ActiveDocument.Tables(2).Tables(3).Cell(4, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
    Case "RED"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
        ActiveDocument.Tables(2).Tables(3).Cell(4, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
    Case Else
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
        ActiveDocument.Tables(2).Tables(3).Cell(4, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
        
        End Select
        End If
        
                                      If ContentControl.Tag = "status_10" Then
    Select Case ContentControl.Range.Text
    Case "GREEN"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
         ActiveDocument.Tables(2).Tables(3).Cell(5, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
    Case "YELLOW"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
        ActiveDocument.Tables(2).Tables(3).Cell(5, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
    Case "RED"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
        ActiveDocument.Tables(2).Tables(3).Cell(5, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
    Case Else
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
        ActiveDocument.Tables(2).Tables(3).Cell(5, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
        
        End Select
        End If
        
                                              If ContentControl.Tag = "status_11" Then
    Select Case ContentControl.Range.Text
    Case "GREEN"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
         ActiveDocument.Tables(2).Tables(3).Cell(6, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
    Case "YELLOW"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
        ActiveDocument.Tables(2).Tables(3).Cell(6, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
    Case "RED"
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
        ActiveDocument.Tables(2).Tables(3).Cell(6, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
    Case Else
        ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
        ActiveDocument.Tables(2).Tables(3).Cell(6, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
        
        End Select
        End If
        
End Sub

答案1

您的代码非常庞大,因此加载文档时可能需要很长时间进行编译。

如果我正确理解了代码,那么您基本上在几次 IF 测试下复制了相同的代码,其中唯一的区别是索引:Cell(2, 1)Cell(3, 1)以及表的索引。

我建议对单元格和表索引使用变量,并且只编写一次代码,类似于以下(未经测试的)代码:

icell = 0
itable = 0

Select Case ContentControl.Range.Text
  Case "status_1"
    icell = 2
    itable = 1
  Case "status_2"
    icell = 3
    itable = 1
... etc ...
  Case "status_11"
    icell = 6
    itable = 3
End Select

If icell <> 0
  Select Case ContentControl.Range.Text
    Case "GREEN"
      ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(0, 255, 0)
      ActiveDocument.Tables(2).Tables(itable).Cell(icell, 1).Shading.BackgroundPatternColor = RGB(0, 255, 0)
    Case "YELLOW"
       ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 255, 0)
       ActiveDocument.Tables(2).Tables(itable).Cell(icell, 1).Shading.BackgroundPatternColor = RGB(255, 255, 0)
    Case "RED"
      ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(255, 0, 0)
      ActiveDocument.Tables(2).Tables(itable).Cell(icell, 1).Shading.BackgroundPatternColor = RGB(255, 0, 0)
    Case Else
      ContentControl.Range.Cells(1).Next.Shading.BackgroundPatternColor = RGB(100, 50, 150)
      ActiveDocument.Tables(2).Tables(itable).Cell(icell, 1).Shading.BackgroundPatternColor = RGB(100, 50, 150)
  End Select
End If

我还没有测试过上述代码。

相关内容