Using shading within a form field

[ABabeNChrist]

I have some code that works great on a document with no section breaks.

Code: Select all

Option Explicit
Dim tCol, i As Integer, tRow As Integer, fFld As String

Sub ColourIt()
    Dim Pwd As String, Tint
    Pwd = ""
    With ActiveDocument
        .Unprotect (Pwd)
        Select Case .FormFields(fFld).Result
        Case "Inspected"
            Tint = RGB(171, 229, 123)
        Case "Functional"
            Tint = RGB(171, 229, 123)
        Case "Inspected - Appears Functional"
            Tint = RGB(171, 229, 123)
        Case "Operational"
            Tint = RGB(171, 229, 123)
        Case "Not Inspected"
            Tint = RGB(190, 190, 190)
        Case "Non-Accessible"
            Tint = RGB(190, 190, 190)
        Case "Limited Inspection"
            Tint = RGB(190, 190, 190)
        Case "Not Present"
            Tint = RGB(120, 220, 255)
        Case "Absent / None"
            Tint = RGB(120, 220, 255)
        Case "Missing"
            Tint = RGB(120, 220, 255)
        Case "Damaged / Repair Needed"
            Tint = RGB(255, 220, 110)
        Case "Non-Functional"
            Tint = RGB(255, 220, 110)
        Case "Recommend Repairs"
            Tint = RGB(255, 220, 110)
        Case "Monitor Conditions"
            Tint = RGB(255, 220, 110)
        Case "Unsatisfactory"
            Tint = RGB(255, 220, 110)
        Case "Unacceptable"
            Tint = RGB(255, 220, 110)
        Case "Attention Recommended"
            Tint = RGB(255, 220, 110)
        Case "Attention Required"
            Tint = RGB(255, 220, 110)
        Case "Defective"
            Tint = RGB(255, 220, 110)
        Case "Further Inspection Needed"
            Tint = RGB(255, 220, 110)
        Case "Further Inspection Recommended"
            Tint = RGB(255, 220, 110)
        Case "Investigate Further"
            Tint = RGB(255, 220, 110)
        Case "Safety Hazard"
            Tint = RGB(250, 100, 95)
        Case "Safety Concern"
            Tint = RGB(250, 100, 95)
        Case "Dangerous"
            Tint = RGB(250, 100, 95)
        End Select

        .Tables(1).Cell(tRow, tCol).Range.Shading.BackgroundPatternColor = Tint
        .Protect wdAllowOnlyFormFields, Noreset:=True, Password:=Pwd
    End With
End Sub
Sub GetFFRef()
    With Selection
        If .FormFields.Count = 0 Then End
        For i = 1 To ActiveDocument.Tables.Count
            If (.Range.Start >= ActiveDocument.Tables(i).Range.Start) And _
               (.Range.End <= ActiveDocument.Tables(i).Range.End) Then
                Exit For
            End If
        Next i
        With .Cells(1)
            fFld = .Range.FormFields(1).Name
            tCol = .ColumnIndex
            tRow = .RowIndex
        End With
    End With
End Sub

But when I apply this same code using section page breaks I receive an error on line

Code: Select all

.Tables(1).Cell(tRow, tCol).Range.Shading.BackgroundPatternColor = Tint

I used numerous docm that use this same approach and consolidated them onto 1 docm, sectioning each document with a section page break.

[HansV]

I think you left out something - as posted, the code doesn't do anything.

[ABabeNChrist]

Hi Hans
SORRY
This goes in My Document module

Code: Select all

Private Sub Document_Open()
If Selection.Information(wdWithInTable) Then Call GetFFRef
End Sub

[HansV]

I'm sorry, it makes no sense to me. Could you post a sample document.

[ABabeNChrist]

Here you go

Sample.docm

[HansV]

Your code makes no sense. The variable i is set but never used, and ColurIt is never called. Are you sure that you haven't omitted parts of the code? As it is now, it won't do anything at all, ever.

[HansV]

I think I know what you have to change:

1) In order to make the code do something, add the line

Call ColourIt

just above the End Sub in GetFFRef.

2) In ColourIt, change Tables(1) to Tables(i)

[ABabeNChrist]

Hi Hans
The drop down form field selects the code on entry and exit as seen here on the properties of form field.

Dropdown.JPG

I doubled checked the download I posted with this thread and it seemed to worked OK on my end, this only a sample of course, I was just unable to get it to work on section page breaks??????

Don’t have a clue why

I will try the changes you have suggested and see what happens

[HansV]

I looked at the Document_Open code only, this didn't do anything. You never mentioned that the macros were called as Enter and Exit macros of the form fields. I see now what you wanted to do. You only need the second change I proposed.

It has nothing to do with the document having multiple sections, but with the document containing multiple tables.

[ABabeNChrist]

Thank you Hans
I apologize for not explaining in more detail.

[ABabeNChrist]

Hi Hans
I was still having problems using this code. it just would not functions correctly. After playing with it for a while I then remembered last year you help me with this somewhat same problem, you then modified the code a little.

Code: Select all

Option Explicit

Dim ff As FormField
Dim cl As Cell

Sub ColourIt()
    Dim Pwd As String
    Dim Tint As Long
    On Error GoTo ExitHere:
    Pwd = ""
    ActiveDocument.Unprotect Password:=Pwd
    Select Case ff.Result
    Case "Inspected", "Functional", "Inspected - Appears Functional", _
         "Operational"
        Tint = RGB(171, 229, 123)
    Case "Not Inspected", "Non-Accessible", "Limited Inspection"
        Tint = RGB(190, 190, 190)
    Case "Not Present", "Absent / None", "Missing"
        Tint = RGB(120, 220, 255)
    Case "Damaged / Repair Needed", "Non-Functional", "Recommend Repairs", _
         "Monitor Conditions", "Unsatisfactory", "Unacceptable", _
         "Attention Recommended", "Attention Required", "Defective", _
         "Further Inspection Needed", "Further Inspection Recommended", _
         "Investigate Further"
        Tint = RGB(255, 220, 110)
    Case "Safety Hazard", "Safety Concern", "Dangerous"
        Tint = RGB(250, 100, 95)
    End Select
    cl.Range.Shading.BackgroundPatternColor = Tint
ExitHere:
    ActiveDocument.Protect Type:=wdAllowOnlyFormFields, NoReset:=True, Password:=Pwd
End Sub

Sub GetFFRef()
    On Error GoTo ExitHere
    With Selection
        If .FormFields.Count > 0 Then
            Set ff = .FormFields(1)
            Set cl = .Cells(1)
        End If
    End With
ExitHere:
End Sub

So I then replaced the old with your modified version and Waa la it seems to work throughout document.
it does work but is a bit slow. I was just wondering if you maybe had any ideas how I may still achieve this same type conditional formatting of sort with a better approach.

[HansV]

Sorry. I have no suggestions to improve this.

[ABabeNChrist]

Thank You Hans
I guess I'll leave things just as there are. A little slower then I was hoping, but it does work