(Word VBA) set CellAlignVerticalTop for every tables in selection

Flicker

New Member
Joined
Feb 19, 2009
Messages
40
Hi,
I want to create VBA that helps me set Word Table format as follow:

- align each table to center of the document - this one work fine.
- set text format in each cells Align Top Left (this is identical to select Table and go to Table Tools > Layout > click Align Top Left at Alignment area.) - this one work but very slow due to triple loop to cell level
- top row (header) should be align center - this one won't work yet
- and set column width to specific value - this one is fine does not have issue

So, what I going to do is I select text which contains several Tables then execute Macro.

The simple record macro is below:
VBA Code:
Sub tableTopLeft()
'
' tableTopLeft Macro
'
'
    Selection.Tables(1).Select
    Selection.SelectCell
    Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
    Selection.Cells.VerticalAlignment = wdCellAlignVerticalTop
End Sub

I just realize that Align Top Left consist of 2 properties -- a) wdAlignParagraphLeft and b) wdCellAlignVerticalTop

But when I combine it with For Loop, the wdCellAlignVerticalTop does not work. -- Run-time error '5941' The requested member of the collection does not exist.

VBA Code:
    Selection.Tables(iTable).Select
    Selection.SelectCell
    Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
   'the code below cause error
    Selection.Cells.VerticalAlignment = wdCellAlignVerticalTop

The work around is I have to loop thrice which very slow.

VBA Code:
Sub TableFormat()
'
' loop all tables to resize and set format
'
'
Dim doc As Document
Set doc = ActiveDocument

Dim intTableCount As Integer
Dim intRowCount As Integer
Dim intCellCount As Integer

Dim iTable As Integer
Dim iCell As Integer
Dim iRow As Integer

intTableCount = Selection.Tables.Count
For iTable = 1 To intTableCount

'align paragraph to left
    Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft

'align table to center
    Selection.Tables(iTable).Rows.Alignment = wdAlignRowCenter
    
'set cell alignment to Top, super slow due to O(n^3)

    intRowCount = Selection.Tables(iTable).Rows.Count

    For iRow = 1 To intRowCount

        intCellCount = Selection.Tables(iTable).Rows(iRow).Cells.Count

        For iCell = 1 To intCellCount

        Selection.Tables(iTable).Rows(iRow).Cells(iCell).VerticalAlignment = wdCellAlignVerticalTop

        Next
    Next

    Selection.Tables(iTable).PreferredWidth = CentimetersToPoints(14.75)
    
'this still won't work
    Selection.Tables(iTable).Rows(1).Alignment = wdAlignRowCenter
    Selection.Tables(iTable).Columns(1).SetWidth ColumnWidth:=CentimetersToPoints(0.95), RulerStyle:= _
        wdAdjustNone
    Selection.Tables(iTable).Columns(2).SetWidth ColumnWidth:=CentimetersToPoints(0.95), RulerStyle:= _
        wdAdjustNone
    Selection.Tables(iTable).Columns(3).SetWidth ColumnWidth:=CentimetersToPoints(7#), RulerStyle:= _
        wdAdjustNone
    Selection.Tables(iTable).Columns(4).SetWidth ColumnWidth:=CentimetersToPoints(6#), RulerStyle:= _
        wdAdjustNone
        
Next

End Sub

Could anyone point me out the way to set "VerticalAlignment = wdCellAlignVerticalTop" without loop 3 times from Table > Rows > Cells please?

Thanks very much
 

Some videos you may like

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.

Macropod

Retired Moderator
Joined
Aug 27, 2007
Messages
3,445
Try:
VBA Code:
Sub Demo()
Application.ScreenUpdating = False
Dim Tbl As Table
For Each Tbl In ActiveDocument.Tables
  With Tbl
    .AllowAutoFit = False
    .Rows.Alignment = wdAlignRowCenter
    .Range.Cells.VerticalAlignment = wdCellAlignVerticalTop
    .Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
    .Rows(1).Cells.VerticalAlignment = wdCellAlignVerticalCenter
    .Rows(1).Range.ParagraphFormat.Alignment = wdAlignParagraphCenter
    .Columns(1).Width = CentimetersToPoints(0.95)
    .Columns(2).Width = CentimetersToPoints(0.95)
    .Columns(3).Width = CentimetersToPoints(7#)
    .Columns(4).Width = CentimetersToPoints(6#)
  End With
Next
Application.ScreenUpdating = True
End Sub
To limit processing to selected tables, change 'ActiveDocument' to 'Selection'.
 

Flicker

New Member
Joined
Feb 19, 2009
Messages
40
Thank you very much, Macropod.
I will try tomorrow and update the result. :D
 

Flicker

New Member
Joined
Feb 19, 2009
Messages
40
ough I forgot that I need to update this a few weeks ago ;_;

Macropod
Your code works perfectly as I want. I will try to update it to selected tables.
Thank you very much. <3
 

Watch MrExcel Video

Forum statistics

Threads
1,108,918
Messages
5,525,623
Members
409,657
Latest member
19JimRon72

This Week's Hot Topics

Top