(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

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes

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
 

Subscribe on YouTube

Watch MrExcel Video

Forum statistics

Threads
1,106,014
Messages
5,508,792
Members
408,694
Latest member
LightBright

This Week's Hot Topics

  • Turn fraction around
    Hello I need to turn a fraction around, for example I have 1/3 but I need to present as 3/1
  • TIme Clock record reformatting to ???
    Hello All, I'd like some help formatting this (Tbl-A)(Loaded via Power Query) [ATTACH type="full" width="511px" alt="PQdata.png"]22252[/ATTACH]...
  • TextBox Match
    hi, I am having a few issues with my code below, what I need it to do is when they enter a value in textbox8 (QTY) either 1,2 or 3 the 3 textboxes...
  • Using Large function based on Multiple Criteria
    Hello, I can't seem to get a Large formula to work based on two criteria's. I can easily get a oldest value based one value, but I'm struggling...
  • Can you check my code please
    Hi, Im going round in circles with a Compil Error End With Without With Here is the code [CODE=rich] Private Sub...
  • Combining 2 pivot tables into 1 chart
    Hello everyone, My question sounds simple but I do not know the answer. I have 2 pivot tables and 2 charts that go with this. However I want to...
Top