Macro to apply alternate row colour to a table (15% grey)?

[StargateFanWrk]

I have separated a table from its header so the macro will apply to an
entire table.

I just need to know simple code that will apply a 15% grey colour to
alternating rows, with the rows in between being without colour. I've tried
the table styles but that just doesn't work as it makes all sorts of other,
unwanted changes. Yet doing this manually would be a pain.

Thanks in advance for any help. :oD

[macropod]

Hi StargateFanWrk,

Try:
Sub Shade_Table_Rows()
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

--
Cheers
macropod
[Microsoft MVP - Word]

"StargateFanWrk" <NoS...@NoJunkMail.com> wrote in message news:eJFEOCGd...@TK2MSFTNGP04.phx.gbl...

[StargateFanWrk]

That is marvellous, simply marvellous. Thank you.

I was able to integrate it with the only other vb script I found that does
something similar (though the colouring there is really funky and not
straightforward like this simple, alternate colouring <g>), that of the
thread here:
http://groups.google.ca/group/microsoft.public.word.vba.general/browse_thread/thread/ad19b4d5080ee7c5/032f2f173ca19de7?hl=en&lnk=gst&q=alternating+row+colour#032f2f173ca19de7

Would there be a way to integrate the script kindly provided here with the
structure from the thread above? I really find the functionality found in
the thread extremely useful, i.e., advising the user when they're not in a
table, pausing, and then resuming the script afterwards when they are, and
also having code to let user change to no colour at all. But there is
something here I obviously don't know how to adjust since no message box
pops up when not in a table. But here is the basic structure of the script
that would be ideal, I think:

Sub Format_table_ROW_colouring()
If Not Selection.Information(wdWithInTable) Then
MsgBox "Select a table before running this macro"
Exit Sub
End If
Call ROW_COLOURING_alternate
End Sub

Sub ROW_COLOURING_alternate()

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 ' determines colour;
change colour references here

Else
.BackgroundPatternColor = wdColorAutomatic
End If
End With
Next
End With
End With
End Sub

'===============================================
Sub ROW_COLOURING_reset_to_no_colour()
With Selection.Shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorAutomatic
End With
End Sub
'===============================================

The code for the last script re resetting row colouring to no colour comes
from the idea in another thread
(http://groups.google.ca/group/microsoft.public.word.vba.general/browse_thread/thread/6e5452253bcdc9da/4a0e421e1d5e2d34?hl=en&lnk=gst&q=remove+row+colouring#).
But again, I'm missing something as it doesn't work.

So other than there being no message box pop up when not in a table to begin
with, and not having the right code for the reset to no colour, this
actually does a pretty good job. I get the rows nicely alternating so my
people will be able to read the phone list without headaches now <g>.

Also, a question, when changing the row colouring, the user has to wait
quite a period of time. Is there a popup that can be can come up saying
"working ...", or something, so user doesn't do anything to the file while
the macro is running thinking that nothing is being done?

Thanks much! :oD

"macropod" <macr...@invalid.invalid> wrote in message
news:eaLqQtGd...@TK2MSFTNGP05.phx.gbl...

[macropod]

Hi StargateFanWrk,

The following revision provides the interactivity, including the option to apply/clear the shading. It also runs much faster, which
should obviate the need for a progress indicator.

Sub Shade_Table_Rows()
Dim i As Integer, Result As Integer, LCol As Long

With Selection
If Not .Information(wdWithInTable) Then

MsgBox "Please select a table before running this macro", vbExclamation
Exit Sub
End If
Result = MsgBox("Apply Table Alternate Row Shading?", vbYesNoCancel)
If Result = vbCancel Then Exit Sub
LCol = -16777216
If Result = vbYes Then LCol = 14277081
Application.ScreenUpdating = False

With .Tables(1)
For i = 1 To .Rows.Count
With .Rows(i).Shading
If i Mod 2 = 0 Then

.BackgroundPatternColor = LCol
Else
.BackgroundPatternColor = -16777216

End If
End With
Next
End With

Application.ScreenUpdating = True
End With
End Sub

--
Cheers
macropod
[Microsoft MVP - Word]

"StargateFanWrk" <NoS...@NoJunkMail.com> wrote in message news:%23GcT2$OdKHA...@TK2MSFTNGP04.phx.gbl...

[StargateFanWrk]

<sigh> I'm envious! How did you do that, that's elegantly simple ...

I know my people, so I had to modify this ever so slightly to provide a bit
more info in the message boxes so that they don't come back to me wide-eyed
and panicky <g>. The text de-mystifies things a little bit.

Here is my version with really just some superficial changes esp. in the
text of the message boxes:

;--------------------------------------
Sub ROW_COLOURING_alternate()

Dim i As Integer, Result As Integer, LCol As Long
With Selection
If Not .Information(wdWithInTable) Then

MsgBox "You have selected a macro that will shade rows in a Word table
with alternating colours." & vbCrLf & "However, you're not in a table." &
vbCrLf & vbCrLf & "Please select a table before running this macro ...",
vbInformation
Exit Sub
End If
Result = MsgBox("APPLY ROW SHADING?" & vbCrLf & vbCrLf & "- ''YES''
shades the rows (alternating colour)." & vbCrLf & "- ''NO'' removes all
shading." & vbCrLf & "", vbYesNoCancel + vbQuestion)

If Result = vbCancel Then Exit Sub
LCol = -16777216
If Result = vbYes Then LCol = 14277081
Application.ScreenUpdating = False
With .Tables(1)
For i = 1 To .Rows.Count
With .Rows(i).Shading
If i Mod 2 = 0 Then
.BackgroundPatternColor = LCol
Else
.BackgroundPatternColor = -16777216
End If
End With
Next
End With
Application.ScreenUpdating = True
End With
End Sub

;--------------------------------------

I added it to a button on one of my toolbars. Thank goodness I'm in a
contract where I'm back on Word 2003 here so that my toolbars work again
<g>.

Thanks. :oD

"macropod" <macr...@invalid.invalid> wrote in message

news:uvorzqPd...@TK2MSFTNGP02.phx.gbl...