(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

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.

Macropod

Retired Moderator
Joined
Aug 27, 2007
Messages
3,446
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
 

Dossfm0q

Active Member
Joined
Mar 9, 2009
Messages
353

ADVERTISEMENT

I have a similar problem with columns line# 2, it is ok with Rows
".Columns(1).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft "
VBA Code:
    .Columns(1).Cells.VerticalAlignment = wdCellAlignVerticalCenter
    .Columns(1).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft '<<<<<< Not working>>>>>
 

Dossfm0q

Active Member
Joined
Mar 9, 2009
Messages
353
Thank you For Respond

VBA Code:
    For R = 1 To .Columns(1).Cells.Count
    .Cell(R, 1).Range.ParagraphFormat.Alignment = wdAlignParagraphLeft
    Next
 

Watch MrExcel Video

Forum statistics

Threads
1,109,130
Messages
5,527,015
Members
409,735
Latest member
viktor90

This Week's Hot Topics

Top