Consulting

Results 1 to 2 of 2

Thread: Alternate Row Shading with a Catch

  1. #1
    VBAX Regular
    Joined
    Apr 2018
    Posts
    14
    Location

    Alternate Row Shading with a Catch

    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]
    Attached Files Attached Files

  2. #2
    VBAX Regular
    Joined
    Apr 2018
    Posts
    14
    Location
    I have continued to work on my problem throughout the day, and I *believe* I have come up with a workaround. If I run Macropod’s ShadeTableRows sub first and call on the second macro, TableMarking, I get the desired result. I made some other minor tweaks, as well. I have posted the new VBA code below.

    If there a better, more efficient way to get to the desired result, I would welcome your help and expertise.

    Thank you in advance for taking a look at this for me.


    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

    Call TableMarking

    End Sub

    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 - Doesn't work w/called sub
    '.Shading.ForegroundPatternColor = wdColorWhite - Doesn't work with called sub

    .Borders.InsideLineStyle = wdLineStyleSingle
    .Borders.InsideLineWidth = wdLineWidth050pt
    .Borders.OutsideLineStyle = wdLineStyleSingle
    .Borders.OutsideLineWidth = wdLineWidth050pt
    .Borders.InsideColor = wdColorBlack
    .Borders.OutsideColor = wdColorBlack35
    .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")
    .Range.Rows.HeadingFormat = True
    .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 = wdColorWhite
    .Borders.OutsideColor = wdColorBlack
    .Borders(wdBorderTop).LineStyle = wdLineStyleSingle
    .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
    .Borders(wdBorderTop).LineWidth = wdLineWidth050pt
    .Borders(wdBorderBottom).LineWidth = wdLineWidth050pt
    .Borders(wdBorderTop).Color = wdColorBlack
    .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.Shading.Texture = wdTextureSolid
    Selection.Shading.ForegroundPatternColor = wdColorWhite
    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 Sub

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •