?
Solved

Alternate grey shading for selected rows of a table

Posted on 2010-01-10
7
Medium Priority
?
677 Views
Last Modified: 2012-05-08
Dear Experts:

with x rows of a table selected I would like to activate a macro that ...

... alternately shades the selected rows grey. The grey shading should begin on the uppermost selected row.

I GOT a macro that does this alternate shading much more comfortable (see macro below <TblAltShadingGrey>), but as soon as the macro hits vertically merged cells, it throws an error message. Therefore I would like to be able to apply alternate grey shading (only) to selected rows.

I am also aware that a user-defined table style could do the above job (alternate grey shading) very easily. But there are a couple of Word 2000 documents where I have to perform these tasks.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas


Sub TblAltShadingGrey()

   Dim oRow As row
   Dim rng As Word.range
   Dim tbl As Table
   Dim StartRow As Long
   Dim ShadedRow As Boolean
   
   
If Not Selection.Information(wdWithInTable) Then
    MsgBox "Please place the cursor into the table", vbOKOnly + vbCritical, "Alternate Grey Shading for selected Table"
     Exit Sub
End If


   StartRow = InputBox("Grey Shading: Enter starting row:", "Alternate Grey Shading")
   
   Set tbl = Selection.Tables(1)
   Set rng = tbl.range

   For Each oRow In tbl.rows
      If oRow.Index >= StartRow Then
         ShadedRow = Not ShadedRow
         If ShadedRow Then
            oRow.Cells.Shading.BackgroundPatternColor = RGB(225, 225, 225)
         Else
            oRow.Cells.Shading.BackgroundPatternColor = wdColorAutomatic
         End If
      End If
   Next
   
 End Sub

Open in new window

0
Comment
Question by:AndreasHermle
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 2
7 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26276799
Hello AndreasHermle,

Try the following change ... it assumes you have selected the rows to be processed.

Regards,

chris_bottomley
Sub TblAltShadingGrey()

   Dim oRow As Row
   Dim rng As Word.Range
'   Dim tbl As Table
   Dim StartRow As Long
   Dim ShadedRow As Boolean
   
   
If Not Selection.Information(wdWithInTable) Then
    MsgBox "Please place the cursor into the table", vbOKOnly + vbCritical, "Alternate Grey Shading for selected Table"
     Exit Sub
End If



   'StartRow = InputBox("Grey Shading: Enter starting row:", "Alternate Grey Shading")
   
   'Set tbl = Selection.Tables(1)
   Set rng = Selection.Range

   For Each oRow In rng.Rows
      If oRow.Index >= StartRow Then
         ShadedRow = Not ShadedRow
         If ShadedRow Then
            oRow.Cells.Shading.BackgroundPatternColor = RGB(225, 225, 225)
         Else
            oRow.Cells.Shading.BackgroundPatternColor = wdColorAutomatic
         End If
      End If
   Next
   
 End Sub

Open in new window

0
 

Author Comment

by:AndreasHermle
ID: 26277126
Hi Chris,

thank you very much for your swift help.

I am afraid to tell you that the macro does not work on tables that contain vertically merged cells, even if the vertically merged cells are not part of the selection (selected rows). On "clean tables", i.e. tables without any vertically merged cells, the macro works fine.

The error (5991 =  Cannot access individual rows in this collection because the table
has vertically merged cells)  occurs on code line 22 (For each oRow in rng.rows)

Help is much appreciated. Thank you very much in advance. Regards, Andreas
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26277185
Apologies I latched onto the select and didn't realise the issue affected the table rathe than s.

I'll look further

Chris
0
Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 2000 total points
ID: 26277295
Changed the direction to cells ... try this but note that if a merged cell is found then the cell is treated as one.

Chris
Sub TblAltShadingGrey()

   Dim cel As Cell
   Dim rng As Word.Range
'   Dim tbl As Table
   Dim StartRow As Long
   Dim ShadedRow As Boolean
   Dim rw As Integer
   Dim col As Integer
   
   
If Not Selection.Information(wdWithInTable) Then
    MsgBox "Please place the cursor into the table", vbOKOnly + vbCritical, "Alternate Grey Shading for selected Table"
     Exit Sub
End If



   'StartRow = InputBox("Grey Shading: Enter starting row:", "Alternate Grey Shading")
   
   'Set tbl = Selection.Tables(1)
   Set rng = Selection.Range

    For rw = Selection.Cells(1).RowIndex To Selection.Cells(Selection.Cells.Count).RowIndex
        ShadedRow = Not ShadedRow
        For col = 1 To Selection.Tables(1).Columns.Count
            Set cel = Selection.Tables(1).Cell(rw, col)
            If ShadedRow Then
                cel.Shading.BackgroundPatternColor = RGB(225, 225, 225)
            Else
                cel.Shading.BackgroundPatternColor = wdColorAutomatic
            End If
        Next
    Next
   
 End Sub

Open in new window

0
 
LVL 59

Assisted Solution

by:Chris Bottomley
Chris Bottomley earned 2000 total points
ID: 26277328
And out of interest the following applies the format to the table within the constraint that the vertically merged cells are set by the first row of the merge.

Chris
Sub TblAltShadingGrey_CRB()
Dim cel As Cell
Dim StartRow As Long
Dim ShadedRow As Boolean
Dim rw As Integer
Dim col As Integer
   
   
    If Not Selection.Information(wdWithInTable) Then
        MsgBox "Please place the cursor into the table", vbOKOnly + vbCritical, "Alternate Grey Shading for selected Table"
         Exit Sub
    End If

    For rw = 1 To Selection.Tables(1).Rows.Count
        ShadedRow = Not ShadedRow
        For col = 1 To Selection.Tables(1).Columns.Count
            Set cel = Nothing
            On Error Resume Next
            Set cel = Selection.Tables(1).Cell(rw, col)
            On Error GoTo 0
            If Not cel Is Nothing Then
                If ShadedRow Then
                    cel.Shading.BackgroundPatternColor = RGB(225, 225, 225)
                Else
                    cel.Shading.BackgroundPatternColor = wdColorAutomatic
                End If
            End If
        Next
    Next
   
 End Sub

Open in new window

0
 

Author Closing Comment

by:AndreasHermle
ID: 31675207
Chris:

   Sir, this is simply great!

   Thank you very much for your terrific help. I really appreciate your professionalism.

Best Regards, Andreas
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 26278458
Glad to help ... and thank you for opening my eyes to the merged cell impact on macros.

Chris
0

Featured Post

On Demand Webinar: Networking for the Cloud Era

Ready to improve network connectivity? Watch this webinar to learn how SD-WANs and a one-click instant connect tool can boost provisions, deployment, and management of your cloud connection.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Shortcuts in Word Just the other day I had a training for Microsoft and they wanted me to show how well the new Windows and Office behaved on a touch device, which by the way is great, but it was only then that I realized that using keyboard shortc…
Preface: When I started this series, I used the term CommandBars because that is the Office Object class that it discusses. Unfortunately, when Microsoft introduced Office 2007, they replaced the standard Commandbar menus with "The Ribbon" and rem…
In this video, we show how to convert an image-only PDF file into a PDF Searchable Image file, that is, a file with both the image (typically from scanning) and text, which is created in an automated fashion with Optical Character Recognition (OCR) …
This video walks the viewer through the process of creating an MLA formatted document, as well as a bibliography with citations.
Suggested Courses

741 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question