Toggling Table Cell Shading

[Gordon Bentley-Mix]

OK Kids, here's a fun one for you.

I have a TextBox on a UserForm for collecting the commencement date of a
lease. However, providing a value is optional because the user may not know
commencement date at the time of creating the document. If a value is
provided then this value, properly formatted, is inserted into a bookmark in
the document. And if a value is NOT provided then boilerplate text is
inserted into the bookmark (because in this instance, the user will print the
document and the commencement date will be filled in by hand when the
customer signs the document). All this is simple stuff, and I have it working
with no problems.

HOWEVER...

The client has just added a twist: The bookmark is located in a table cell,
and the client has asked that the cell shading be toggled between "Clear" if
the UserForm value is used and "15% (grey)" if the boilerplate text is used -
ostensibly to call attention to the fact that the commencement date needs to
be entered by hand. Toggling the shading isn't that hard; I can do it using
variations on something like the following sample code (which I banged
together by modifying code generated from the macro recorder):

Sub ShadingTest()
Dim myRange As Range
Set myRange =
ActiveDocument.Bookmarks("txtCommencementDate").Range.Tables(1).Cell(3,
2).Range
With myRange.Shading
.Texture = wdTexture15Percent 'or wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorAutomatic
End With
End Sub

What I'm struggling with is trying to find a way to specify the target cell
based on the "relative location" of the bookmark rather than using the
explicit location of "Cell(3, 2)" or some such. I would prefer this approach
for future-proofing purposes because I'd rather not have to touch the code if
at some point down the line I make some changes to the table that contains
the bookmark (e.g. add some rows before the bookmark or split a cell - which
would totally stuff everything).

Is this even possible? Suggestions on how to do it?
--
Cheers!

Gordon Bentley-Mix
Word MVP

Uninvited email contact will be marked as SPAM and ignored. Please post all
follow-ups to the newsgroup.

 

[Greg Maxey]

Dad,

I think it is possilble if I understand your objective. Basically if
the Bookmark is in the Cell and the bookmark text length is = 0 you
want the cell shaded:

Sub ShadingTest()
Dim oTbl As Word.Table
Dim oCell As Cell
Set oTbl = ActiveDocument.Tables(1)
For Each oCell In oTbl.Range.Cells
If ActiveDocument.Bookmarks("Test").Range.InRange(oCell.Range) Then
If Len(ActiveDocument.Bookmarks("Test").Range.Text) = 0 Then
With oCell.Range.Shading
.Texture = wdTexture15Percent 'or wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorAutomatic
End With
Else
With oCell.Range.Shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorAutomatic
End With
End If
End If
Next oCell
End Sub

 

[Gordon Bentley-Mix]

Not quite Son, but I think I can get it to work - tomorrow! (Well, Thursday
actually cuz it's my "business development" day tomorrow, which means I'm
going to sit in the sun and play my guitar for most of the day.) It's time to
go home now. I'll let you know what I come up with.
--
Cheers!

Gordon Bentley-Mix
Word MVP

Uninvited email contact will be marked as SPAM and ignored. Please post all
follow-ups to the newsgroup.

 

[Gordon Bentley-Mix]

Got it sussed Greg. I'll show you how in a minute. First let me clarify my
objective and determining factors therein.

The rule for setting the shading is based on whether a value for the
commencement date has been entered in the UserForm or not. If a value _has_
been entered then clear the shading (and insert the commencement date), and
if it _hasn't_ then set it to 15% (and insert a bit of boilerplate). I can't
use the length of the bookmark text because it will never be 0 (zero). On the
first run of the template, the bookmark will contain "placeholder" text, and
on subsequent reruns, it will contain either the commencement date or
boilerplate text. Consequently, your code doesn't quite work - but it did
give me a clue on how my code _should_ work.

BTW, before I go any further, I should probably tell you that there are
actually a couple of places where I need similar functionality: around the
commencement date and around the signing date. As I looked more closely at
this requirement, I realised that I could just use one procedure that
accepted arguments for the bookmark and the desired level of shading. This
information wasn't critical to original question, as what I really needed to
know was how to identify the cell that contained the bookmark - and that's
what your code allowed me to do.

Now on to the code. First the code for inserting the commencement date,
which calls the code for setting the shading:

Private Sub InsertCommencementDate()
Dim Temp As String
If Len(CommencementDate) > 0 Then
Temp = CommencementDate
SetShading "txtCommencementDate", wdTextureNone
Else
Temp = [a long string of boilerplate that I've omitted]
SetShading "txtCommencementDate", wdTexture15Percent
End If
InsertBookmarkValue "txtCommencementDate", Temp
End Sub

I'm sure you can figure out what it does, and I'm sure you'll ask if there's
anything that you have questions about. The sub for the inserting the signing
date varies only in the variable that's evaluated and the bookmark that's
passed to "SetShading" - which looks like this:

Public Sub SetShading(myBookmarkName As String, myShading As WdTextureIndex)
With myDoc
If .Bookmarks.Exists(myBookmarkName) = True Then
Dim myTable As Table
Dim myCell As Cell
Set myTable = .Bookmarks(myBookmarkName).Range.Tables(1)
For Each myCell In myTable.Range.Cells
If .Bookmarks(myBookmarkName).Range.InRange(myCell.Range) = True Then
With myCell.Range.Shading
.Texture = myShading
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorAutomatic
End With
Exit For
End If
Next myCell
End If
End With
End Sub

(Note that it's declared as 'Public' only because it's in a module of common
"tools".)

Anyway, thanks for pointing me in the right direction. It was the "InRange"
function that was the key. Of course, I could have simplified the whole
process by just selecting the bookmark and working with the Selection object
instead, but that would be sloppy... ;-D
--
Cheers!

Gordon Bentley-Mix
Word MVP

Uninvited email contact will be marked as SPAM and ignored. Please post all
follow-ups to the newsgroup.

 

[Greg Maxey]

Seems to do the job ;-)

Got it sussed Greg. I'll show you how in a minute. First let me
clarify my objective and determining factors therein.

The rule for setting the shading is based on whether a value for the
commencement date has been entered in the UserForm or not. If a value
_has_ been entered then clear the shading (and insert the
commencement date), and if it _hasn't_ then set it to 15% (and insert
a bit of boilerplate). I can't use the length of the bookmark text
because it will never be 0 (zero). On the first run of the template,
the bookmark will contain "placeholder" text, and on subsequent
reruns, it will contain either the commencement date or boilerplate
text. Consequently, your code doesn't quite work - but it did give me
a clue on how my code _should_ work.

BTW, before I go any further, I should probably tell you that there
are actually a couple of places where I need similar functionality:
around the commencement date and around the signing date. As I looked
more closely at this requirement, I realised that I could just use
one procedure that accepted arguments for the bookmark and the
desired level of shading. This information wasn't critical to
original question, as what I really needed to know was how to
identify the cell that contained the bookmark - and that's what your
code allowed me to do.

Now on to the code. First the code for inserting the commencement
date, which calls the code for setting the shading:

Private Sub InsertCommencementDate()
Dim Temp As String
If Len(CommencementDate) > 0 Then
Temp = CommencementDate
SetShading "txtCommencementDate", wdTextureNone
Else
Temp = [a long string of boilerplate that I've omitted]
SetShading "txtCommencementDate", wdTexture15Percent
End If
InsertBookmarkValue "txtCommencementDate", Temp
End Sub

I'm sure you can figure out what it does, and I'm sure you'll ask if
there's anything that you have questions about. The sub for the
inserting the signing date varies only in the variable that's
evaluated and the bookmark that's passed to "SetShading" - which
looks like this:

Public Sub SetShading(myBookmarkName As String, myShading As
WdTextureIndex) With myDoc
If .Bookmarks.Exists(myBookmarkName) = True Then
Dim myTable As Table
Dim myCell As Cell
Set myTable = .Bookmarks(myBookmarkName).Range.Tables(1)
For Each myCell In myTable.Range.Cells
If .Bookmarks(myBookmarkName).Range.InRange(myCell.Range) =
True Then With myCell.Range.Shading
.Texture = myShading
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorAutomatic
End With
Exit For
End If
Next myCell
End If
End With
End Sub

(Note that it's declared as 'Public' only because it's in a module of
common "tools".)

Anyway, thanks for pointing me in the right direction. It was the
"InRange" function that was the key. Of course, I could have
simplified the whole process by just selecting the bookmark and
working with the Selection object instead, but that would be
sloppy... ;-D

Dad,

I think it is possilble if I understand your objective. Basically if
the Bookmark is in the Cell and the bookmark text length is = 0 you
want the cell shaded:

Sub ShadingTest()
Dim oTbl As Word.Table
Dim oCell As Cell
Set oTbl = ActiveDocument.Tables(1)
For Each oCell In oTbl.Range.Cells
If ActiveDocument.Bookmarks("Test").Range.InRange(oCell.Range) Then
If Len(ActiveDocument.Bookmarks("Test").Range.Text) = 0 Then
With oCell.Range.Shading
.Texture = wdTexture15Percent 'or wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorAutomatic
End With
Else
With oCell.Range.Shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorAutomatic
End With
End If
End If
Next oCell
End Sub