Shade box IF checked (protected form)

K

~KO

Word 2000 - protected form using checkboxes in a table format
Yes and No checkboxes are in their own cell

Would like to set the NO checkbox to turn cell red if selected.

This is the macro and the first Selection line keeps highlighting yellow and
I get a '4605' error message.
--------
Selection.FormFields.Add Range:=Selection.Range, Type:= _
wdFieldFormTextInput
Selection.FormFields.Add Range:=Selection.Range, Type:=wdFieldFormCheckBox
Selection.FormFields.Add Range:=Selection.Range, Type:=wdFieldFormDropDown
With Selection.FormFields(1)
.Name = "Check4"
.EntryMacro = ""
.ExitMacro = ""
.Enabled = True
.OwnHelp = False
.HelpText = ""
.OwnStatus = False
.StatusText = ""
With .CheckBox
.AutoSize = True
.Size = 10
.Default = True
End With
End With
With Selection.Cells.shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorRed
End With
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth225pt
.DefaultBorderColor = wdColorGray40
End With
End Sub
Sub Macro2()
'
' Macro2 Macro
' Macro recorded 3/23/2005 by KAOlan
'
Selection.MoveUp Unit:=wdLine, Count:=5
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=2
Selection.SelectColumn
Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Selection.Columns.PreferredWidth = InchesToPoints(5)
End Sub
Sub InsertTableFieldNameDesc()
'
' InsertTableFieldNameDesc Macro
' Macro recorded 3/23/2005 by KAOlan
'
ActiveDocument.Tables.Add Range:=Selection.Range, NumRows:=5,
NumColumns:= _
2, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:= _
wdAutoFitFixed
Selection.SelectColumn
Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Selection.Columns.PreferredWidth = InchesToPoints(1.7)
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.SelectColumn
Selection.Columns.PreferredWidthType = wdPreferredWidthPoints
Selection.Columns.PreferredWidth = InchesToPoints(5)
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=5
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.SelectRow
With Selection.Cells
With .shading
.Texture = wdTextureNone
.ForegroundPatternColor = wdColorAutomatic
.BackgroundPatternColor = wdColorGray125
End With
With .Borders(wdBorderLeft)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderRight)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderTop)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderBottom)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
With .Borders(wdBorderVertical)
.LineStyle = wdLineStyleSingle
.LineWidth = wdLineWidth050pt
.Color = wdColorAutomatic
End With
.Borders(wdBorderDiagonalDown).LineStyle = wdLineStyleNone
.Borders(wdBorderDiagonalUp).LineStyle = wdLineStyleNone
.Borders.Shadow = False
End With
With Options
.DefaultBorderLineStyle = wdLineStyleSingle
.DefaultBorderLineWidth = wdLineWidth050pt
.DefaultBorderColor = wdColorAutomatic
End With
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Tables(1).Select
Selection.Font.Name = "Arial"
Selection.Font.Name = "Arial"
Selection.Font.Size = 10
Selection.MoveLeft Unit:=wdCharacter, Count:=1
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Field Name"
Selection.MoveRight Unit:=wdCell
Selection.Font.Bold = wdToggle
Selection.TypeText Text:="Field Description"
End Sub
 
G

Greg Maxey

KO,

The document (or at least the section) has to be unprotected and reprotected
to change the cell color. Something like:

Sub ColorCell()
Dim oForm As Document
Set oForm = ActiveDocument
oForm.Unprotect
If oForm.FormFields("Check2").Result = True Then
Selection.Cells(1).Shading.BackgroundPatternColor = wdColorRed
Else
Selection.Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
End If
oForm.Protect Type:=wdAllowOnlyFormFields, NoReset:=True

End Sub

Where "Check2" is a one of your no check boxes in its own cell.
 
G

Greg Maxey

KO,

A little refined:

Run macro on exit from each "NO" checkbox:

Sub ColorCell()
Dim oForm As Document
Set oForm = ActiveDocument
oForm.Unprotect
If Selection.FormFields(1).Result = True Then
Selection.Cells(1).Shading.BackgroundPatternColor = wdColorRed
Else
Selection.Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
End If
oForm.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
End Sub
 
K

~KO

Thanks for your support! I tried this and got a compile error Expected End
Sub. I always say...I know enough to be dangerous and I am trying to learn
more.
 
K

~KO

Greg You Rule! I just had a coworker walk by and he showed me two things I
needed to fix. Had to comment out Sub ColorCell and get rid of an extra End
Sub.
thank you again!
 
K

~KO

Sorry, I wondered if you could tell me how to turn off the shading if the
user unchecked NO. I'm thinking ahead to the user community when they
accidentally check NO. When I uncheck No the red is still there even if I
unprotect and protect the form. thanks!
 
K

~KO

Never mind it does reset to white!

Greg Maxey said:
KO,

A little refined:

Run macro on exit from each "NO" checkbox:

Sub ColorCell()
Dim oForm As Document
Set oForm = ActiveDocument
oForm.Unprotect
If Selection.FormFields(1).Result = True Then
Selection.Cells(1).Shading.BackgroundPatternColor = wdColorRed
Else
Selection.Cells(1).Shading.BackgroundPatternColor = wdColorAutomatic
End If
oForm.Protect Type:=wdAllowOnlyFormFields, NoReset:=True
End Sub



--
Greg Maxey/Word MVP
See:
http://gregmaxey.mvps.org/word_tips.htm
For some helpful tips using Word.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top