Cell Background Fill

I'm trying to fill a cell with a background color via VBA. My code (below)
doesn't work, although the same code altered to SetCellContentColor works
fine, and retrieving the cell background color (via GetCellBackgroundColor)
with essentially this code also works. Is the SetCellBackgroundColor method
just broken?

Public Sub ShadeCell()
Dim oEnt As AcadEntity
Dim oTable As AcadTable
Dim R As Long
Dim C As Long
Dim Util As AcadUtility
Dim vPt As Variant
Dim vVec(0 To 2) As Double
Dim color As AcadAcCmColor

Set Util = ThisDrawing.Utility

On Error Resume Next
Util.GetEntity oEnt, vPt, vbCrLf & "Select cell to shade: "
If oEnt Is Nothing Or Not TypeOf oEnt Is AcadTable Then
MsgBox "You must select a table object."
GoSub Cleanup
Else
Set color = New AcadAcCmColor
color.ColorMethod = acColorMethodByACI
color.ColorIndex = 254
Set oTable = oEnt
vVec(0) = 0: vVec(1) = 0: vVec(2) = 1
oTable.HitTest vPt, vVec, R, C
oTable.SetCellBackgroundColor R, C, color
End If

Cleanup:
Set Util = Nothing
Set oTable = Nothing
Set oEnt = Nothing
Set color = Nothing
End Sub

Ben Rand
CAD Manager
CEntry Constructors & Engineers

 

Ben,

You need to tell AutoCAD that there _is_ a background to show:

oTable.HitTest vPt, vVec, R, C
oTable.SetCellBackgroundColorNone R, C, False '<- added
oTable.SetCellBackgroundColor R, C, color


--
R. Robert Bell


I'm trying to fill a cell with a background color via VBA. My code (below)
doesn't work, although the same code altered to SetCellContentColor works
fine, and retrieving the cell background color (via GetCellBackgroundColor)
with essentially this code also works. Is the SetCellBackgroundColor method
just broken?

Public Sub ShadeCell()
Dim oEnt As AcadEntity
Dim oTable As AcadTable
Dim R As Long
Dim C As Long
Dim Util As AcadUtility
Dim vPt As Variant
Dim vVec(0 To 2) As Double
Dim color As AcadAcCmColor

Set Util = ThisDrawing.Utility

On Error Resume Next
Util.GetEntity oEnt, vPt, vbCrLf & "Select cell to shade: "
If oEnt Is Nothing Or Not TypeOf oEnt Is AcadTable Then
MsgBox "You must select a table object."
GoSub Cleanup
Else
Set color = New AcadAcCmColor
color.ColorMethod = acColorMethodByACI
color.ColorIndex = 254
Set oTable = oEnt
vVec(0) = 0: vVec(1) = 0: vVec(2) = 1
oTable.HitTest vPt, vVec, R, C
oTable.SetCellBackgroundColor R, C, color
End If

Cleanup:
Set Util = Nothing
Set oTable = Nothing
Set oEnt = Nothing
Set color = Nothing
End Sub

Ben Rand
CAD Manager
CEntry Constructors & Engineers

 

Robert,

How in the world did you figure that one out? Many thanks, your answer
worked great.

Ben

 

Dogged determination!

--
R. Robert Bell


Robert,

How in the world did you figure that one out? Many thanks, your answer
worked great.

Ben

 

My kind of programmer!

 

What is *really* cool, is that using this thread as a basis, I came up with
a function to apply the "background mask" to a cell! See the 2005 ng for the
function, if you wish.

 

Nice!

 

Variation on that theme:

Sub SetTableToBackground()
Dim oEnt As AcadEntity
Dim oTable As AcadTable
Dim R As Long
Dim C As Long
Dim Util As AcadUtility
Dim vPt As Variant
Dim newColor As AcadAcCmColor

Set Util = ThisDrawing.Utility

On Error Resume Next
Util.GetEntity oEnt, vPt, vbCrLf & "Select cell to add background mask: "
If TypeOf oEnt Is AcadTable Then
Set oTable = oEnt
oTable.SetBackgroundColorNone acDataRow + acHeaderRow + acTitleRow,
False
Set newColor = oTable.GetBackgroundColor(acUnknownRow)
newColor.SetRGB 0, 0, 0
oTable.SetBackgroundColor acDataRow + acHeaderRow + acTitleRow, newColor
End If

Set oEnt = Nothing
Set Util = Nothing
Set oTable = Nothing
Set newColor = Nothing
End Sub

Ben

 

Also nice! although I would suggest revising the prompt just a smidge.

--
R. Robert Bell


Variation on that theme:

Sub SetTableToBackground()
Dim oEnt As AcadEntity
Dim oTable As AcadTable
Dim R As Long
Dim C As Long
Dim Util As AcadUtility
Dim vPt As Variant
Dim newColor As AcadAcCmColor

Set Util = ThisDrawing.Utility

On Error Resume Next
Util.GetEntity oEnt, vPt, vbCrLf & "Select cell to add background mask: "
If TypeOf oEnt Is AcadTable Then
Set oTable = oEnt
oTable.SetBackgroundColorNone acDataRow + acHeaderRow + acTitleRow,
False
Set newColor = oTable.GetBackgroundColor(acUnknownRow)
newColor.SetRGB 0, 0, 0
oTable.SetBackgroundColor acDataRow + acHeaderRow + acTitleRow, newColor
End If

Set oEnt = Nothing
Set Util = Nothing
Set oTable = Nothing
Set newColor = Nothing
End Sub

Ben

 

Caught that after I posted--oops.