VBA to colour table cells and add values when a function key is pr

P

Peter

I have a VBA application that teachers can use to mark assignments by placing
their cursor in a particular cell in a table then pressing function keys.
Each row in the table corresponds to a specific performance standard (and
contains a mark) and the last column is used to store the total marks. If the
teacher places the cursor in a row and presses F6 then that row is coloured
and the mark is inserted into the last colum in that that row. You can see a
screen image at
http://emarking-assistant.baker-evans.com/screen_image.htm

Currently the VBA does not need to know what row or cell the cursor is in
and it uses the following to move around the table or make selections
Selection.EndKey Unit:=wdRow, Extend:=True
Selection.HomeKey Unit:=wdRow
Selection.MoveRight Unit:=wdCell, count:=2

The next version of the application will be a little more complicated and
will require VBA to know what cell the cursor is in so it can put the correct
mark in the corresponding total cell.

How can VBA know what cell the cursor is in when a function key is pressed?
And then move to the 5 column in that row and insert a value into it.

Thanks in advance for any assistance,
Peter Evans
 
G

Greg Maxey

You would assign the function key to something like this:

Sub ScratchMaco()
Dim oColS As String, oRowS As String
If Selection.Information(wdWithInTable) And Selection.Cells.Count < 2 Then
With Selection
oColS = .Information(wdStartOfRangeColumnNumber)
oRowS = .Information(wdStartOfRangeRowNumber)
Selection.Tables(1).Cell(oRowS, 5).Range.Text = "The selection is at
column: " & oColS & " row: " & oRowS & "."
End With
Else
MsgBox "Please ensure the selection is contained withing a single table
cell."
End If
End Sub
 
P

Peter

Greg,

Thanks. The info you provided has been very helpful. In the current version
criteria are listed in rows and standards in columns from poor to excellent.
The heading for the standards can be white or coloured. If coloured then that
colour is used to highlight the cell and the mark (if not then brite green is
used). e.g.

if oTbl.Cell(1, oColS).Shading.BackgroundPatternColorIndex = wdWhite Then
oTbl.Cell(oRowS, oColS).Shading.BackgroundPatternColorIndex = wdBrightGreen
Else
oTbl.Cell(oRowS, oColS).Shading.BackgroundPatternColor = _
oTbl.Cell(1, oColS).Shading.BackgroundPatternColor
End If

Below is a link to a screen image
http://emarking-assistant.baker-evans.com/tempdropbox/markingRubric.gif

Function keys increment or decrement the mark if there is a mark range. I
would like to vary the brighness of the shading based on the incrementing. I
tried usinng
Selection.Shading.Texture
but that produced only a colur with black of white dots.

How can I vary the colour in increments around a
Selection.Shading.BackgroundPatternColor
or
Selection.Shading.BackgroundPatternColorIndex

As always thanks in advance for any assistance,
Peter Evans
 
G

Greg Maxey

Peter,

You could use RBG values. Something like this:

Sub ScratchMaco()
Dim i As Long 'Shading factor
i = 45 * InputBox("Enter a value grade 0 to 5")
Selection.Cells(1).Range.Shading.BackgroundPatternColor = RGB(255, i + 0, i
+ 0)
End Sub

A zero entry applies solid red.
 

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