VBA to shade a table row and insert value into 3rd column of that

[Peter]

I am working on a tool that will assist teachers to fill out a marking
rubric. The rubric will be a word table with many rows with the following 3
coumns
* cloumn with checkbox that they click
* the marking standard with the mark as the first word
* column for the awarded mark

You can see a mockup of the table at
http://www.usq.edu.au/users/evansp/browse/eMarking_Assistant/markingRubric.doc

If the user clicks the checkbox then
* the relevant row will be shaded
* the mark (the first word in the second cell) will be inserted into the
third cell in the row

The code under the checkbox will need to be general so users can copy the
checkbox when they want to add more items to the marking rubric.

My questions are:
* How can VBA determine the row for the checkbox that was ticked
* how can I refer to the mark for that standard (the first word in the
second cell in that row)

Peter

 

[Graham Mayor]

The shading is relatively straightforward. Simply ensure that the Checkbox
fields are named according to the row of the table they are located in. ie
the first check box is in row 5 so call that one Check5 etc. If you then run
the macro ' fCBOnExit' on exit from each check box field it will grab the
number from the fieldname and use that to format the row which matches that
number, either white or your particular shade of green according to whether
the check box is checked, Column 4 will remain formatted yellow.

Putting the first word in the second cell of that row into the third cell
(presumably replacing the 0) when the check box is checked is also covered.

Create a new vba module and add the following code -
http://www.gmayor.com/installing_macro.htm

Private mstrFF As String

Public Sub fCBOnExit()
Dim bProtected As Boolean
Dim oTable As Table
Dim rCell2 As Range
Dim rCell3 As Range
Dim sNum() As String
With ActiveDocument
Set oTable = .Tables(1)
If .ProtectionType <> wdNoProtection Then
bProtected = True
.Unprotect Password:=""
End If
With GetCurrentFF
mstrFF = GetCurrentFF.name
sNum = Split(mstrFF, "k")
Set rCell2 = oTable.Cell(sNum(1), 2).Range
rCell2.End = rCell2.End - 1
Set rCell3 = oTable.Cell(sNum(1), 3).Range
rCell3.End = rCell3.End - 1
If .CheckBox.Value = True Then
oTable.Rows(sNum(1)).Shading.BackgroundPatternColor =
5296274
oTable.Cell(sNum(1), 4).Shading.BackgroundPatternColor =
wdColorYellow
rCell3.Text = rCell2.Words(1)
Else
oTable.Rows(sNum(1)).Shading.BackgroundPatternColor =
wdColorWhite
oTable.Cell(sNum(1), 4).Shading.BackgroundPatternColor =
wdColorYellow
rCell3.Text = "0"
End If
End With
If bProtected = True Then
.Protect _
Type:=wdAllowOnlyFormFields, _
NoReset:=True, Password:=""
End If
End With
End Sub


Private Function GetCurrentFF() As Word.FormField
Dim rngFF As Word.Range
Dim fldFF As Word.FormField
Set rngFF = Selection.Range
rngFF.Expand wdParagraph
For Each fldFF In rngFF.FormFields
Set GetCurrentFF = fldFF
Exit For
Next
End Function


--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Peter]

Graham,

Thanks for your speedie reply,

I've entered the code into the document at:
http://www.usq.edu.au/users/evansp/browse/eMarking_Assistant/markingRubric.doc

The document needs to be locked (with no password) so you can click the
checkboxes.

As it is the code is only activated once you change a checkbox then exit it
and change another. How can I setup the checkboxes and code so the row is
highlighted as soon as I click the checkbox, and unhighlighted as soon as I
uncheck it.

I have also added the following debug.print statement to see exactly what is
going and when the code is activated.

Debug.Print "Row:" & sNum(1) & " Mark:" & rCell2.Words(1) & " Checked?:" &
..CheckBox.Value

Another possible issue is that the form has to be protected (so the
checkboxes can be checked) but the peopel will need to enter comments into
the document at any stage. Can I lock the checkboxes without locking the
doucment?

As always thanks for assistance in advance,
PeterEvans

 

[Graham Mayor]

That's how protected forms work! They have to be locked to check the
checkboxes. The macro runs on exit from the field i.e when you tab out of
the field. There is no mechanism available whereby the change is
instantaneous.
If you want users to be able to add comments, add text form fields to take
the comments.

--
<>>< ><<> ><<> <>>< ><<> <>>< <>><<>
Graham Mayor - Word MVP


<>>< ><<> ><<> <>>< ><<> <>>< <>><<>

 

[Peter]

I've decided to use a simpler approach that does not involve any checkboxes
in the table. This means that the user can add other criteria and standards
without needing to add checkboxes or lock the form.

The interface is that they click their cursor in the row they want to
highlight then click "Select Standard" on the floating userform. This
highlights the row and puts the mark in the last column. There is also an
"Unseelct standard" button and one to add and rescale the marks.

The functioning document is available for download at:
http://www.usq.edu.au/users/evansp/browse/eMarking_Assistant/markingRubric.doc

The code is below:
Public Sub ShowMarkingRubricToolbar()
'show the marking rubric toolbar
Dim UFrm As MarkingRubric
Set UFrm = New MarkingRubric
With UFrm
.Show vbModeless
End With
End Sub

Sub addRescale()
On Error GoTo errorHandler
Selection.Tables(1).Select
'need to update the fields twice as easlier fields are based on values
in later fields
Selection.Fields.Update
Selection.Fields.Update
Exit Sub

errorHandler:
Debug.Print "Error # " & Str(Err.Number) & Err.Description
If Err.Number = 5941 Then
MsgBox "You must place your cursor in the marking rubric table you
want to update.", vbOKOnly
Else
MsgBox "Error # " & Str(Err.Number) & " " & Err.Description & "
Please send details to (e-mail address removed)", vbOKOnly
End If
End Sub

Sub selectStandard()
On Error GoTo errorHandler
Dim theresult As String
Dim theStandard As String
Dim theMark As String
Selection.HomeKey Unit:=wdRow
Selection.EndKey Unit:=wdRow, Extend:=True
theStandard = Selection.Text
theMark = Left(theStandard, (InStr(theStandard, " ") - 1))
If Not IsNumeric(theMark) Then
theresult = MsgBox("This standard does not have a mark as the first
word. Do you want to continue", vbYesNo)
If theresult = vbNo Then
Exit Sub
End If
End If
Selection.Shading.Texture = wdTextureNone
Selection.Shading.ForegroundPatternColor = wdColorAutomatic
Selection.Shading.BackgroundPatternColor = wdColorLightGreen
If IsNumeric(theMark) Then
Selection.EndKey Unit:=wdRow
Selection.MoveLeft Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:=theMark
End If

Exit Sub
errorHandler:
Debug.Print "Error # " & Str(Err.Number) & Err.Description
If Err.Number = 4605 Then
MsgBox "You must place your cursor in the row of the standard you
want to select.", vbOKOnly
Else
MsgBox "Error # " & Str(Err.Number) & " " & Err.Description & "
Please send details to (e-mail address removed)", vbOKOnly
End If
End Sub

Sub unselectStandard()
On Error GoTo errorHandler
Dim theStandard As String
Dim theMark As String
Selection.HomeKey Unit:=wdRow
Selection.EndKey Unit:=wdRow, Extend:=True
Selection.Shading.Texture = wdTextureNone
Selection.Shading.ForegroundPatternColor = wdColorAutomatic
Selection.Shading.BackgroundPatternColor = wdColorWhite
Selection.EndKey Unit:=wdRow
Selection.MoveLeft Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.TypeText Text:=0

Exit Sub
errorHandler:
Debug.Print "Error # " & Str(Err.Number) & Err.Description
If Err.Number = 4605 Then
MsgBox "You must place your cursor in the row of the standard you
want to unselect.", vbOKOnly
Else
MsgBox "Error # " & Str(Err.Number) & " " & Err.Description & "
Please send details to (e-mail address removed)", vbOKOnly
End If
End Sub