Any help would be much appreciated
Geoff
As you cannot format a table cell with the form locked, the code must also
unlock and relock the form as below.
Sub ColourCells()
Dim oFld As FormFields
Dim bProtected As Boolean
'Unprotect the file
If ActiveDocument.ProtectionType <> wdNoProtection Then
bProtected = True
ActiveDocument.Unprotect Password:=""
End If
Set oFld = ActiveDocument.FormFields
With ActiveDocument.Tables(1).Cell(1, 3)
Select Case oFld("Text1").Result
Case Is = "R"
.Shading.BackgroundPatternColor = wdColorRed
Case Is = "G"
.Shading.BackgroundPatternColor = wdColorGreen
Case Is = "A"
.Shading.BackgroundPatternColor = wdColorGold
Case Is = "r"
.Shading.BackgroundPatternColor = wdColorRed
Case Is = "g"
.Shading.BackgroundPatternColor = wdColorGreen
Case Is = "a"
.Shading.BackgroundPatternColor = wdColorGold
Case Else
'Do nothing
End Select
End With
'Reprotect the document.
If bProtected = True Then
ActiveDocument.Protect _
Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=""
End If
End Sub
--
Regards,
Jay Freedman
Microsoft Word MVP FAQ: http://word.mvps.org
Email cannot be acknowledged; please post all follow-ups to the newsgroup so
all may benefit.
Private Sub oApp_WindowSelectionChange(ByVal Sel As Selection)
Dim j As Long, k As Long
Dim aCol As Column
Dim aCell As Cell
' don't bother and exit if it is not my test document
If ActiveDocument.Name <> "TestEvents.doc" Then Exit Sub
' set variables for the bookmark
j = ActiveDocument.Bookmarks("TestCol").Range.Start
k = ActiveDocument.Bookmarks("TestCol").Range.End
' check if the Selection is in the table in question
If Selection.Start > j And _
Selection.Start < k Then
' set a Column object for the column to color
Set aCol = ActiveDocument.Bookmarks("TestCol").Range _
.Columns(7)
' set a Cell object for the cell Selection is in
Set aCell = Selection.Range.Cells(1)
' test that cell content using NewCellText function
Select Case UCase(NewCellText(aCell))
Case "R"
aCol.Shading.BackgroundPatternColor = wdColorDarkRed
Case "A"
aCol.Shading.BackgroundPatternColor = wdColorGold
Case "G"
aCol.Shading.BackgroundPatternColor = wdColorBrightGreen
Case Else
Exit Sub
End Select
End If
End Sub
Function NewCellText(aCell As Cell) As String
Dim sText As String
sText = aCell.Range.Text
NewCellText = Left(sText, Len(sText) - 2)
End Function
This would have to be adjusted to fully match your logic requirements, as
again, I am not fully following. Also note that if the cursor is a point (no
text selected) and you type "a", the SelectionChange event does NOT fire.
Why? Because the Selection has not changed. Typing text does not fire
SelectionChange. Changing the Selection fires SelectionChange.
--
Message posted via http://www.officekb.com