Code:
Private Sub btnBuildTable2_Click()
On Error Resume Next
Dim strStatus As String
'strStatus = "Compliant"
strStatus = "Non-Compliant Low"
'strStatus = "Non-Compliant Medium"
'strStatus = "Non-Compliant High"
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Add()
Set objRange = objDoc.Range()
objDoc.Tables.Add objRange, 1, 4
Set objTable = objDoc.Tables(1)
objTable.Style = "table grid"
'Add Rows
objTable.Rows.Add
objTable.Rows.Add
objTable.Rows.Add
With objTable
.Cell(2, 4).Range.Cells(1).Split numcolumns:=2
'Do Merges
.Cell(Row:=1, Column:=1).Merge _
MergeTo:=.Cell(Row:=1, Column:=4)
.Cell(Row:=2, Column:=1).Merge _
MergeTo:=.Cell(Row:=2, Column:=3)
.Cell(Row:=3, Column:=1).Merge _
MergeTo:=.Cell(Row:=3, Column:=4)
.Cell(Row:=4, Column:=1).Merge _
MergeTo:=.Cell(Row:=4, Column:=3)
End With
With objTable
'Do Colors
.Rows.Item(2).Shading.BackgroundPatternColor = RGB(255, 255, 0) 'Yellow
.Rows.Item(3).Shading.BackgroundPatternColor = RGB(222, 219, 222) 'Gray
End With
With objTable
'Write "Static" text
.Cell(2, 2).Range.Font.Bold = True
.Cell(2, 2).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(2, 2).VerticalAlignment = wdCellAlignVerticalCenter
.Cell(2, 2).Range.Text = "Test" & vbCrLf & "Results"
.Cell(2, 3).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(2, 3).VerticalAlignment = wdCellAlignVerticalCenter
.Cell(2, 3).Range.Font.Bold = True
.Cell(2, 3).Range.Text = "Impact" & vbCrLf & "Code"
End With
With objTable
'Write "Dynamic" text
.Cell(1, 1).Range.Font.Bold = True
.Cell(1, 1).Range.Text = "{(U) Table B<<NUM>>: <<TABLETITLE>>"
.Cell(3, 1).Range.Font.Bold = True
.Cell(3, 1).Range.Text = "<<IA CONTROL>>"
Select Case strStatus
Case "Compliant"
.Cell(4, 2).Shading.BackgroundPatternColor = RGB(0, 178, 82)
.Cell(4, 2).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(4, 2).VerticalAlignment = wdCellAlignVerticalCenter
.Cell(4, 2).Range.Font.Bold = True
.Cell(4, 2).Range.Text = strStatus
Case "Non-Compliant Low"
.Cell(4, 2).Range.Cells(1).Split numcolumns:=2
.Cell(4, 2).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(4, 2).VerticalAlignment = wdCellAlignVerticalCenter
.Cell(4, 2).Shading.BackgroundPatternColor = RGB(255, 0, 0)
.Cell(4, 2).Range.Font.Bold = True
.Cell(4, 2).Range.Text = "Non-Compliant"
.Cell(4, 3).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(4, 3).VerticalAlignment = wdCellAlignVerticalCenter
.Cell(4, 3).Shading.BackgroundPatternColor = RGB(255, 0, 0)
.Cell(4, 3).Range.Font.Bold = True
.Cell(4, 3).Range.Text = "Low"
Case "Non-Compliant Medium"
.Cell(4, 2).Range.Cells(1).Split numcolumns:=2
.Cell(4, 2).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(4, 2).VerticalAlignment = wdCellAlignVerticalCenter
.Cell(4, 2).Shading.BackgroundPatternColor = RGB(255, 0, 0)
.Cell(4, 2).Range.Font.Bold = True
.Cell(4, 2).Range.Text = "Non-Compliant"
.Cell(4, 3).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(4, 3).VerticalAlignment = wdCellAlignVerticalCenter
.Cell(4, 3).Shading.BackgroundPatternColor = RGB(255, 0, 0)
.Cell(4, 3).Range.Font.Bold = True
.Cell(4, 3).Range.Text = "Medium"
Case "Non-Compliant High"
.Cell(4, 2).Range.Cells(1).Split numcolumns:=2
.Cell(4, 2).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(4, 2).VerticalAlignment = wdCellAlignVerticalCenter
.Cell(4, 2).Shading.BackgroundPatternColor = RGB(255, 0, 0)
.Cell(4, 2).Range.Font.Bold = True
.Cell(4, 2).Range.Text = "Non-Compliant"
.Cell(4, 3).Range.Paragraphs.Alignment = wdAlignParagraphCenter
.Cell(4, 3).VerticalAlignment = wdCellAlignVerticalCenter
.Cell(4, 3).Shading.BackgroundPatternColor = RGB(255, 0, 0)
.Cell(4, 3).Range.Font.Bold = True
.Cell(4, 3).Range.Text = "High"
End Select
With objTable.Rows(4).Cells(1).Range.Select
Selection.Font.Bold = True
Selection.TypeText Text:="<<IA TEAM NAME>> Test Results: "
Selection.TypeParagraph
Selection.Font.Bold = False
Selection.TypeText Text:="<<RESULTS>> "
Selection.TypeParagraph
Selection.Font.Bold = True
Selection.TypeText Text:="<<IA TEAM NAME>> Comments: "
Selection.TypeParagraph
Selection.Font.Bold = False
Selection.TypeText Text:="<<COMMENTS>> "
Selection.TypeParagraph
Selection.Font.Bold = True
Selection.TypeText Text:="Severity Code Recommendations: "
Selection.TypeParagraph
Selection.Font.Bold = False
Selection.TypeText Text:="<<RECOMMENDATIONS>>"
End With
End With
Set CommentsCell = Nothing
Set objWord = Nothing
Set objDoc = Nothing
Set objTable = Nothing
End Sub