On Nov 11, 8:24*pm, Jay Freedman wrote:
There's nothing general you can do that will work regardless of
whether any particular table has merged cells or not. If you know with
absolute certainty what your table looks like (because you set it up
in a template and don't let anyone alter it), then you can program to
that specific circumastance. Instead of checking Rows.Count and
Columns.Count, check for the specific cell coordinates of cell C.
You would also want to start the event handler with a check for
whether the ActivDocument.AttachedTemplate is the one that contains
the table; if not, immediately Exit Sub. That will take care of the
possibility that a document based on your template and one based on a
different template are open at the same time (because the event
handler fires for all documents).
--
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.
On Wed, 11 Nov 2009 14:30:09 -0800 (PST), Larry Sulky
wrote:
On Nov 4, 10:22*am, "Jay Freedman" wrote:
* * If Not ((thisRow = thisTable.Rows.Count) And _
* * * * * * (thisCol = thisTable.Columns.Count)) Then
* * * * Selection.MoveRight Unit:=wdCell
* * Else
Say, Jay, I adapted this code to something I'm doing and I've got a
problem. My table is two columns, and in the last two rows the cells
in the right column are merged:
+----+-----+
| *A *| * * *|
+----+ *B *|
| *C *| * * *|
+----+-----+
So the Selection.MoveRight Unit:=wdCell moves the selection from Cell
A to Cell B, then to Cell C, then back to Cell B. Cell A is at
(r1,c1), B is at (r1,c2), and C is at (r2,c1). There is no cell that
has the maximum row count and the maximum column count. That is, there
is no cell at (r2,c2). So the condition in the snippet above is true
for cell B both times the selection hits it, and on the second time,
the MoveRight creates a new row.
Any way to prevent that new row from being created?
TIA
---larry- Hide quoted text -
- Show quoted text -
Thanks, Jay. As it happens I don't know the exact shape of the table;
the macro has to work on any shape. So instead of using a MoveRight
command, I've changed my approach to use a two-dimensional array to
capture values for cells. In the following sample code, I'm capturing
the vertical alignment and background colour of cells prior to
changing the table style to Table Normal (which clobbers those two
attributes, among many others). Then I can restore those attributes
cell by cell. It's working fine for my purposes, and sidesteps the
issue of accidentally creating new rows.
---larry
Sub CTS()
'''''''''
On Error GoTo ErrMsg:
If Not Selection.Information(wdWithInTable) Then Exit Sub
Dim myTbl As Table
Dim myRow As Long
Dim myCol As Long
Dim maxRow As Long
Dim maxCol As Long
Set myTbl = Selection.Tables(1)
maxRow = myTbl.Rows.Count
maxCol = myTbl.Columns.Count
'''\ Set a two-dimensional array.
' Unfortunately, we can't set the values _
using variables, but we also can't set _
a multidimensional array without values, _
and in any case we can't ReDim both _
dimensions to variable values. So we _
just have to set fixed values and hope _
that they're big enough.
Dim cellColour(100, 100) As Double
Dim cellVertAlign(100, 100) As Double
'''/
On Error GoTo NoCell1:
For myRow = 1 To maxRow
For myCol = 1 To maxCol
cellColour(myRow, myCol) = _
myTbl.Cell(myRow, myCol).Shading.BackgroundPatternColor
cellVertAlign(myRow, myCol) = _
myTbl.Cell(myRow, myCol).VerticalAlignment
NoCell1: ' If a cell doesn't exist (because of merging)
Next
Next
On Error GoTo ErrMsg:
With myTbl
.Style = "Table Normal"
.ApplyStyleHeadingRows = False
.ApplyStyleLastRow = False
.ApplyStyleFirstColumn = False
.ApplyStyleLastColumn = False
End With
On Error GoTo NoCell2:
For myRow = 1 To maxRow
For myCol = 1 To maxCol
myTbl.Cell(myRow, myCol).Shading.BackgroundPatternColor = _
cellColour(myRow, myCol)
myTbl.Cell(myRow, myCol).VerticalAlignment = _
cellVertAlign(myRow, myCol)
NoCell2: ' If a cell doesn't exist (because of merging)
Next
Next
On Error GoTo ErrMsg:
GoTo Bye:
ErrMsg:
MsgBox "Whatever",,"ERROR"
Bye:
'''''''
End Sub