MSWORD macros for table

[Nimmi Srivastav]

Hi,

You guys are amazing. Your macros are so succinct, and yet so
powerful. I am truly in awe.

I now need help with 2 macros: actually one with two variants.

I want to selectively merge cells in a table. Here's what I want to
do:

1). Prompt user for a range of row numbers (say {r1} through {r2})
Prompt user for a column number (say {c1})
In the rows {r1} through {r2}, merge cells in columns {c1} and
{c1}+1


2). Prompt user for a range of column numbers (say {c1} through {c2})
Prompt user for a row number (say {r1})
In the columns {c1} through {c2}, merge cells in rows {r1} and
{r1}+1

Thanks in advance,
NS

 

[Graham Mayor]

Try

Dim oTable As Table
Dim Cols As String
Dim r1 As Long, r2 As Long
Dim c1 As Long, c2 As Long
Set oTable = ActiveDocument.Tables(1)
Cols = MsgBox("Merge columns?" & vbCr & _
"Click 'yes' to merge columns, 'No' to merge rows", _
vbYesNo, "Merge cells")
Select Case Cols
Case Is = vbNo
r1Row:
r1 = InputBox("Enter row number", "Merge Rows")
If r1 > oTable.Rows.Count Then
MsgBox "Column out of range", vbCritical, "Error"
r1 = 0
GoTo r1Row
End If
If r2 < oTable.Rows.Count Then
r2 = r1 + 1
Else
r2 = r1
End If
c1 = InputBox("Enter first column number", "Merge Rows")
c2 = InputBox("Enter last column number", "Merge Rows")
If c1 = c2 Or c2 > oTable.Columns.Count Then
MsgBox "Columns out of range", vbCritical, "Error"
Exit Sub
End If
With oTable
.Cell(Row:=r1, Column:=c1).Merge _
MergeTo:=.Cell(Row:=r1, Column:=c2)
If r2 < oTable.Rows.Count Then
.Cell(Row:=r2, Column:=c1).Merge _
MergeTo:=.Cell(Row:=r2, Column:=c2)
End If
End With
Case Is = vbYes
c1Col:
c1 = InputBox("Enter column number", "Merge Columns")
If c1 > oTable.Columns.Count Then
MsgBox "Column out of range", vbCritical, "Error"
GoTo c1Col
End If
If c1 < oTable.Columns.Count Then
c2 = c1 + 1
Else
c2 = c1
End If
r1 = InputBox("Enter first row number", "Merge Columns")
r2 = InputBox("Enter last row number", "Merge Columns")
If r2 = r1 Or r2 > oTable.Rows.Count Then
MsgBox "Rows out of range", vbCritical, "Error"
Exit Sub
End If
With oTable
.Cell(Row:=r1, Column:=c1).Merge _
MergeTo:=.Cell(Row:=r2, Column:=c1)
If c2 > c1 Then
.Cell(Row:=r1, Column:=c2).Merge _
MergeTo:=.Cell(Row:=r2, Column:=c2)
End If
End With
Case Else
Exit Sub
End Select

http://www.gmayor.com/installing_macro.htm

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


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

 

[nimmi_srivastav]

Try

Dim oTable As Table
Dim Cols As String
Dim r1 As Long, r2 As Long
Dim c1 As Long, c2 As Long
Set oTable = ActiveDocument.Tables(1)
Cols = MsgBox("Merge columns?" & vbCr & _
"Click 'yes' to merge columns, 'No' to merge rows", _
vbYesNo, "Merge cells")
Select Case Cols
    Case Is = vbNo

Graham weaves his magic again, but I goofed up slightly in providing
the requirements. My apologies. What I really wanted to do is the
following:

1). Prompt user for a range of row numbers (say {r1} through {r2})
Prompt user for a column number (say {c1})
For each row from {r1} through {r2}
merge cells in columns {c1} and {c1}+1
EndFor


2). Prompt user for a range of column numbers (say {c1} through {c2})
Prompt user for a row number (say {r1})
For each column from {c1} through {c2}
merge cells in rows {r1} and {r1}+1
EndFor



In other words, I don't want the result of the operation to be one
jumbo cell that spans multiple rows (Case 1) or multiple columns (Case
2). I would like the pre-existing row boundaries to be maintained in
Case 1 and pre-existing column boundaries to be maintained in Case 2.

Thanks once again,

NS

 

[Graham Mayor]

I don't understand how you can merge cells without merging them to create a
larger cell? Your requirement as restated doesn't appear to make any sense?


Graham weaves his magic again, but I goofed up slightly in providing
the requirements. My apologies. What I really wanted to do is the
following:


In other words, I don't want the result of the operation to be one
jumbo cell that spans multiple rows (Case 1) or multiple columns (Case
2). I would like the pre-existing row boundaries to be maintained in
Case 1 and pre-existing column boundaries to be maintained in Case 2.

Thanks once again,

NS

 

[Nimmi Srivastav]

I don't understand how you can merge cells without merging them to createa
larger cell? Your requirement as restated doesn't appear to make any sense?

<[email protected]> wrote in message

Let me cite an example. Suppose we have a 6 x 5 table (6 rows, 5
columns)

Case 1: (For each of r2 through r4, merge columns c3 and c4)
The result of this operation should be as follows:
r1: c1, c2, c3, c4, c5
r2: c1, c2, {c3+c4}, c5
r3: c1, c2, {c3+c4}, c5
r4: c1, c2, {c3+c4}, c5
r5: c1, c2, c3, c4, c5
r6: c1, c2, c3, c4, c5

So we are merging c3 and c4, but only in r2, r3 and r4. The important
thing is that we have three separate merged cells, in r2, r3 and r4
and NOT one jumbo merged cell that spans c3 and c4 from rows r2
through r4


Case 2: (For each of c2 through c4, merge rows r3 and r4)
The result of this operation should be as follows:
r1: c1, c2, c3, c4, c5
r2: c1, c2, c3, c4, c5
r3: c1, {c2 + c3 + c4}, c5
r4: c1, {c2 + c3 + c4}, c5
r5: c1, c2, c3, c4, c5
r6: c1, c2, c3, c4, c5

So we are merging r3 and r4, but only in c2, c3 and c4. The important
thing is that we have two separate merged cells, in r3 and r4 and NOT
one jumbo merged cell that spans c2 through c4 across r3 and r4.

HTH and once again, TIA!
NS

 

[Graham Mayor]

That's what the original macro does - however, it is not possible to merge
the rows *and* columns, as I believe you are describing them, in the *same*
table.
The macro merges *either* columns or rows. It merges the row/column you
select and the adjacent row/column as requested in your original message. It
appears from your description you are trying to merge half a merged cell
with an unmerged cell and that is not possible.

I don't understand how you can merge cells without merging them to create
a
larger cell? Your requirement as restated doesn't appear to make any
sense?

<[email protected]> wrote in message

Let me cite an example. Suppose we have a 6 x 5 table (6 rows, 5
columns)

Case 1: (For each of r2 through r4, merge columns c3 and c4)
The result of this operation should be as follows:
r1: c1, c2, c3, c4, c5
r2: c1, c2, {c3+c4}, c5
r3: c1, c2, {c3+c4}, c5
r4: c1, c2, {c3+c4}, c5
r5: c1, c2, c3, c4, c5
r6: c1, c2, c3, c4, c5

So we are merging c3 and c4, but only in r2, r3 and r4. The important
thing is that we have three separate merged cells, in r2, r3 and r4
and NOT one jumbo merged cell that spans c3 and c4 from rows r2
through r4


Case 2: (For each of c2 through c4, merge rows r3 and r4)
The result of this operation should be as follows:
r1: c1, c2, c3, c4, c5
r2: c1, c2, c3, c4, c5
r3: c1, {c2 + c3 + c4}, c5
r4: c1, {c2 + c3 + c4}, c5
r5: c1, c2, c3, c4, c5
r6: c1, c2, c3, c4, c5

So we are merging r3 and r4, but only in c2, c3 and c4. The important
thing is that we have two separate merged cells, in r3 and r4 and NOT
one jumbo merged cell that spans c2 through c4 across r3 and r4.

HTH and once again, TIA!
NS

 

[Doug Robbins - Word MVP]

Use:

Dim firstcell As String, lastcell As String
Dim fr As Long, fc As Long, lr As Long, lc As Long
Dim i As Long
Dim mergerange As Range
firstcell = InputBox("Enter the top left cell to be merged (in Rownum:colnum
format).")
lastcell = InputBox("Enter the bottom right cell to be merged.")
fr = Val(Left(firstcell, InStr(firstcell, ":") - 1))
fc = Val(Mid(firstcell, InStr(firstcell, ":") + 1))
lr = Val(Left(lastcell, InStr(firstcell, ":") - 1))
lc = Val(Mid(lastcell, InStr(firstcell, ":") + 1))
With ActiveDocument.Tables(1)
For i = fr To lr
Set mergerange = .Cell(i, fc).Range
mergerange.End = .Cell(i, lc).Range.End
mergerange.Cells.Merge
Next i
End With