Hi andreas,
This is pretty tricky to do. Might I ask what the reason you want to do
this - maybe there is an alternative approach. Anyway, ...
I haven't checked Lene's code but am not sure it's possible that way. Here
is a different approach, which I hope will work, using the Selection; I have
put a few comments in that try to explain what's happening. I have tried to
keep lines fairly short but beware line breaks in the newsreader! I haven't
exhaustively tested it - let me know if it works.
Sub CheckForverticallyMergedCells()
Dim CurrentCellRowIndex As Long
Dim CurrentCellColumnIndex As Long
Dim PrevCellRowIndex As Long
Dim PrevCellColumnIndex As Long
Dim PenultimateRowIndex As Long
Dim UltimateColumnIndex As Long
Dim VerticallyMergedCells As Boolean
If Selection.Tables.Count = 0 Then
MsgBox "Please place your cursor in a Table"
Exit Sub
End If
Selection.Tables(1).Range.Cells(Selection.Tables(1).Range.Cells.Count).Select
PrevCellRowIndex = Selection.Cells(1).RowIndex
PrevCellColumnIndex = Selection.Cells(1).ColumnIndex
PenultimateRowIndex = PrevCellRowIndex - 1
UltimateColumnIndex = PrevCellColumnIndex
Do While Not VerticallyMergedCells
If PrevCellRowIndex = 1 And PrevCellColumnIndex = 1 Then
' Special case: 1- or 2-row Table
Exit Do
End If
WordBasic.PrevCell
CurrentCellRowIndex = Selection.Cells(1).RowIndex
CurrentCellColumnIndex = Selection.Cells(1).ColumnIndex
If CurrentCellRowIndex = PrevCellRowIndex Then
' Gone back one cell in current row - nothing special to do
PrevCellColumnIndex = CurrentCellColumnIndex
Else ' Gone to previous row
If PrevCellColumnIndex = 1 Then ' We came from Column 1
If CurrentCellRowIndex < PenultimateRowIndex _
And PrevCellRowIndex = PenultimateRowIndex Then
Exit Do ' All done - no vertically merged cells found
ElseIf CurrentCellRowIndex <> PrevCellRowIndex - 1 Then
' Gone back two (or more) rows
VerticallyMergedCells = True
ElseIf CurrentCellColumnIndex > UltimateColumnIndex Then
' Gone to right of last cell in last row - must be merged
VerticallyMergedCells = True
Else ' Gone to last cell of penultimate row - good.
PrevCellRowIndex = CurrentCellRowIndex
PrevCellColumnIndex = CurrentCellColumnIndex
End If
Else
' Prev Cell was not Column 1, so Column 1 must be merged
VerticallyMergedCells = True
End If
End If
Loop
MsgBox "Vertically merged cells were " & _
IIf(VerticallyMergedCells, "", "NOT ") & _
"found in the last two rows of the selected table"
End Sub
--
Enjoy,
Tony
www.WordArticles.com
It can be rather tricky to handle tables with merged cells in VBA. After a
number of experiments that did not give a reliable result, I ended with
the
macro below. It gave the correct result in all my tests no matter how I
merged cells vertically and/or horizontally. See the comments in the
macro.
The idea is to get the result by provoking an error if vertically merged
cells are found in the second last row in the table. If there are
vertically
merged cells in the last row, there will also be in the second last row so
there is no need to check more than the second last row. However, there
can
be vertically merged cells in the second last row and not in the last row
(if
cell(s) are merged with cell(s) above).
Sub Table_CheckMergedCells_Last2Rows()
Dim bMerged As Boolean
Dim n As Long
On Error GoTo ErrorHandler
'Stop if selection not in table
If Selection.Information(wdWithInTable) = False Then
MsgBox "The selection must be in a table."
Exit Sub
Else:
'Stop if table has 1 col or 1 row only
With Selection.Tables(1)
If .Rows.Count = 1 Or .Columns.Count = 1 Then
MsgBox "The selected table has only one column and/or row."
Exit Sub
End If
bMerged = False
'Try to do something with second last row
'If vertically merged cells found, error 5991 occurs
'Handled by ErrorHandler
n = .Rows(.Rows.Count - 1).Cells.Count
End With
End If
Continue:
'Show msg
If bMerged = True Then
MsgBox "Vertically merged cells are found in the last two rows of
the selected table."
Else
MsgBox "No vertically merged cells are found in the last two rows of
the selected table."
End If
Exit Sub
'=========================
ErrorHandler:
If Err.Number = 5991 Then 'vertically merged cells
bMerged = True
Err.Clear
GoTo Continue
End If
End Sub
--
Regards
Lene Fredborg - Microsoft MVP (Word)
DocTools - Denmarkwww.thedoctools.com
Document automation - add-ins, macros and templates for Microsoft Word
- Show quoted text -
Dear Lene,
thank you very much for your swift help. I tested your macro on a
couple of tables. It is working with the exception of tables that
feature vertically merged cells in rows above the last two rows.
On these tables I also got the message that there are vertically
merged cells in the last two rows of the tables. According to the
macro requirement, this message should only come up if the last two
rows of the selected table contain vertically merged cells.
I am aware that this is a somewhat weird requirement and I understand
that is tricky to work with VBA on these kind of tables, so actually
it is up to you to invest more time in some complex solution. The
current solution is already HELPFUL to me. Regards, Andreas
