T-Belle
10-27-2020, 05:47 AM
Good morning, VBA Brain Trust!
I hope you can help me. I have the following VBA code (TableMarking) that has worked for the past 15 years or so. Now, I need to update it so there is alternate row shading. This shading would have to begin with Row 3 and stop at the second to last row. I have attached an example of an end result table (Table_End_Result.docx). Each table I would need to format using these macros is different as far as number of rows and columns.
I searched online and came across the ShadeTableRows code (by Macropod), which is also shown below. With my limited VBA knowledge/abilities, I do not know how to modify it such that it will shade all rows except the first two and the very last.
Is there a way to combine the two subroutines? If not, is there a way to update ShadeTableRows so that it will only shade the rows I select? Although it would be more convenient to run one shortcut, I am not opposed to running two. I do not want to complicate matters as I am looking for the easiest solution. I would be thrilled with anything that gets to the end result.
Sub TableMarking()
Dim objTable As Table
Dim myRange As Range
For Each objTable In Selection.Tables
With objTable
.RightPadding = 5
.LeftPadding = 5
.TopPadding = 0
.BottomPadding = 0
.Rows.SpaceBetweenColumns = CentimetersToPoints(0.2)
.Rows.AllowBreakAcrossPages = False
.Rows.Alignment = wdAlignRowCenter
.Rows.HeightRule = wdRowHeightAuto
.Shading.Texture = wdTextureSolid
.Shading.ForegroundPatternColor = wdColorWhite
.Borders.InsideLineStyle = wdLineStyleSingle
.Borders.InsideLineWidth = wdLineWidth050pt
.Borders.OutsideLineStyle = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth050pt
.Borders.InsideColor = wdColorGray35
.Borders.OutsideColor = wdColorGray35
.Range.Style = ActiveDocument.Styles("Table Body")
.Range.Font.Reset
.Range.ParagraphFormat.Reset
.Range.Cells.VerticalAlignment = wdAlignVerticalTop
'Add (TBD) row – top left
Set myRange = objTable.Rows(1).Range
objTable.Rows(1).Select
Selection.InsertRowsAbove
Selection.Cells.Merge
Selection.Borders(wdBorderTop).LineStyle = wdLineStyleNone
Selection.Borders.OutsideLineStyle = wdLineStyleNone
Selection.Style = ActiveDocument.Styles("Table Body")
Selection.TypeText Text:="(TBD)"
With .Rows(2) 'Style the header row
.Range.Style = ActiveDocument.Styles("Table Heading")
.Cells.VerticalAlignment = wdAlignVerticalTop
.Shading.Texture = wdTextureNone
.Shading.ForegroundPatternColor = wdColorAutomatic
.Shading.BackgroundPatternColor = wdColorGray
.Borders.InsideLineStyle = wdLineStyleSingle
.Borders.InsideLineWidth = wdLineWidth050pt
.Borders.OutsideLineStyle = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth050pt
.Borders.InsideColor = wdColorBlack
.Borders.OutsideColor = wdColorBlack
.Borders(wdBorderTop).LineStyle = wdLineStyleSingle
.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
.Borders(wdBorderTop).LineWidth = wdLineWidth050pt
.Borders(wdBorderBottom).LineWidth = wdLineWidth050pt
.Borders(wdBorderTop).Color = wdColorGrayBlack
.Borders(wdBorderBottom).Color = wdColorBlack
End With 'end header row style
'Add (TBD) row – bottom right
Set myRange = objTable.Rows(.Rows.Count).Range
objTable.Rows(.Rows.Count).Select
Selection.InsertRowsBelow
Selection.Cells.Merge
Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
Selection.Borders.OutsideLineStyle = wdLineStyleNone
Selection.Style = ActiveDocument.Styles("Table Body")
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.TypeText Text:="(TBD)"
With .Rows(.Rows.Count - 1) 'last data row in the table
.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
.Borders(wdBorderBottom).LineWidth = wdLineWidth050pt
.Borders(wdBorderBottom).Color = wdColorBlack
.Borders.InsideLineStyle = wdLineStyleSingle
.Borders.InsideLineWidth = wdLineWidth050pt
.Borders.InsideColor = wdColorBlack
End With 'end last data row settings
End With
Next objTable
End If
End Sub
Sub ShadeTableRows()
Dim i As Integer
With Selection
If Not .Information(wdWithInTable) Then Exit Sub
With .Tables(1)
For i = 1 To .Rows.Count
With .Rows(i).Shading
If i Mod 2 = 0 Then
.BackgroundPatternColor = wdColorGray15
Else
.BackgroundPatternColor = wdColorAutomatic
End If
End With
Next
End With
End With
End Sub
[/CODE]
I hope you can help me. I have the following VBA code (TableMarking) that has worked for the past 15 years or so. Now, I need to update it so there is alternate row shading. This shading would have to begin with Row 3 and stop at the second to last row. I have attached an example of an end result table (Table_End_Result.docx). Each table I would need to format using these macros is different as far as number of rows and columns.
I searched online and came across the ShadeTableRows code (by Macropod), which is also shown below. With my limited VBA knowledge/abilities, I do not know how to modify it such that it will shade all rows except the first two and the very last.
Is there a way to combine the two subroutines? If not, is there a way to update ShadeTableRows so that it will only shade the rows I select? Although it would be more convenient to run one shortcut, I am not opposed to running two. I do not want to complicate matters as I am looking for the easiest solution. I would be thrilled with anything that gets to the end result.
Sub TableMarking()
Dim objTable As Table
Dim myRange As Range
For Each objTable In Selection.Tables
With objTable
.RightPadding = 5
.LeftPadding = 5
.TopPadding = 0
.BottomPadding = 0
.Rows.SpaceBetweenColumns = CentimetersToPoints(0.2)
.Rows.AllowBreakAcrossPages = False
.Rows.Alignment = wdAlignRowCenter
.Rows.HeightRule = wdRowHeightAuto
.Shading.Texture = wdTextureSolid
.Shading.ForegroundPatternColor = wdColorWhite
.Borders.InsideLineStyle = wdLineStyleSingle
.Borders.InsideLineWidth = wdLineWidth050pt
.Borders.OutsideLineStyle = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth050pt
.Borders.InsideColor = wdColorGray35
.Borders.OutsideColor = wdColorGray35
.Range.Style = ActiveDocument.Styles("Table Body")
.Range.Font.Reset
.Range.ParagraphFormat.Reset
.Range.Cells.VerticalAlignment = wdAlignVerticalTop
'Add (TBD) row – top left
Set myRange = objTable.Rows(1).Range
objTable.Rows(1).Select
Selection.InsertRowsAbove
Selection.Cells.Merge
Selection.Borders(wdBorderTop).LineStyle = wdLineStyleNone
Selection.Borders.OutsideLineStyle = wdLineStyleNone
Selection.Style = ActiveDocument.Styles("Table Body")
Selection.TypeText Text:="(TBD)"
With .Rows(2) 'Style the header row
.Range.Style = ActiveDocument.Styles("Table Heading")
.Cells.VerticalAlignment = wdAlignVerticalTop
.Shading.Texture = wdTextureNone
.Shading.ForegroundPatternColor = wdColorAutomatic
.Shading.BackgroundPatternColor = wdColorGray
.Borders.InsideLineStyle = wdLineStyleSingle
.Borders.InsideLineWidth = wdLineWidth050pt
.Borders.OutsideLineStyle = wdLineStyleSingle
.Borders.OutsideLineWidth = wdLineWidth050pt
.Borders.InsideColor = wdColorBlack
.Borders.OutsideColor = wdColorBlack
.Borders(wdBorderTop).LineStyle = wdLineStyleSingle
.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
.Borders(wdBorderTop).LineWidth = wdLineWidth050pt
.Borders(wdBorderBottom).LineWidth = wdLineWidth050pt
.Borders(wdBorderTop).Color = wdColorGrayBlack
.Borders(wdBorderBottom).Color = wdColorBlack
End With 'end header row style
'Add (TBD) row – bottom right
Set myRange = objTable.Rows(.Rows.Count).Range
objTable.Rows(.Rows.Count).Select
Selection.InsertRowsBelow
Selection.Cells.Merge
Selection.Borders(wdBorderBottom).LineStyle = wdLineStyleNone
Selection.Borders.OutsideLineStyle = wdLineStyleNone
Selection.Style = ActiveDocument.Styles("Table Body")
Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
Selection.TypeText Text:="(TBD)"
With .Rows(.Rows.Count - 1) 'last data row in the table
.Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
.Borders(wdBorderBottom).LineWidth = wdLineWidth050pt
.Borders(wdBorderBottom).Color = wdColorBlack
.Borders.InsideLineStyle = wdLineStyleSingle
.Borders.InsideLineWidth = wdLineWidth050pt
.Borders.InsideColor = wdColorBlack
End With 'end last data row settings
End With
Next objTable
End If
End Sub
Sub ShadeTableRows()
Dim i As Integer
With Selection
If Not .Information(wdWithInTable) Then Exit Sub
With .Tables(1)
For i = 1 To .Rows.Count
With .Rows(i).Shading
If i Mod 2 = 0 Then
.BackgroundPatternColor = wdColorGray15
Else
.BackgroundPatternColor = wdColorAutomatic
End If
End With
Next
End With
End With
End Sub
[/CODE]