Microsoft Office Forums - View Single Post - [Solved] Format selected table in academic style

macropod · 11-19-2024, 11:47 PM

Your links point to a variety of table layouts. It's impossible to know from that what you actually expect. It's also impossible to create a single table Style that accommodates all those formats.

The following macro creates an "Academic" table Style that might work in some scenarios.

Code:

Sub AcademicTableStyle()
With ActiveDocument
  .Styles.Add Name:="Academic", Type:=wdStyleTypeTable
  With .Styles("Academic")
    'Set the table body alignment
    .ParagraphFormat.Alignment = wdAlignParagraphRight
    With .Table
      'Set the alignments for the first column and row
      .Condition(wdFirstRow).ParagraphFormat.Alignment = wdAlignParagraphLeft
      .Condition(wdFirstColumn).ParagraphFormat.Alignment = wdAlignParagraphLeft
      'Make the first row Bold
      .Condition(wdFirstRow).Font.Bold = True
      'Set cell padding - to keep text away from edges
      .TopPadding = InchesToPoints(0)
      .BottomPadding = InchesToPoints(0)
      .LeftPadding = InchesToPoints(0.125)
      .RightPadding = InchesToPoints(0.125)
      'Clear all borders & shading
      .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
      .Borders(wdBorderRight).LineStyle = wdLineStyleNone
      .Borders(wdBorderHorizontal).LineStyle = wdLineStyleNone
      .Borders(wdBorderVertical).LineStyle = wdLineStyleNone
      .Shading.Texture = wdTextureNone
      .Shading.ForegroundPatternColor = wdColorAutomatic
      .Shading.BackgroundPatternColor = wdColorAutomatic
      'Set the bottom border for the table
      .Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
      .Borders(wdBorderBottom).LineWidth = wdLineWidth050pt
      .Borders(wdBorderBottom).Color = wdColorAutomatic
      'Set the top & bottom border for the first row
      .Condition(wdFirstRow).Borders(wdBorderBottom).LineStyle = wdLineStyleSingle
      .Condition(wdFirstRow).Borders(wdBorderBottom).LineWidth = wdLineWidth050pt
      .Condition(wdFirstRow).Borders(wdBorderBottom).Color = wdColorAutomatic
      .Condition(wdFirstRow).Borders(wdBorderTop).LineStyle = wdLineStyleSingle
      .Condition(wdFirstRow).Borders(wdBorderTop).LineWidth = wdLineWidth050pt
      .Condition(wdFirstRow).Borders(wdBorderTop).Color = wdColorAutomatic
      'Configure the row banding
      .Condition(wdOddRowBanding).Shading.Texture = wdTextureNone
      .Condition(wdOddRowBanding).Shading.ForegroundPatternColor = wdColorAutomatic
      .Condition(wdOddRowBanding).Shading.BackgroundPatternColor = wdColorGray125
      .Condition(wdEvenRowBanding).Shading.Texture = wdTextureNone
      .Condition(wdEvenRowBanding).Shading.ForegroundPatternColor = wdColorAutomatic
      .Condition(wdEvenRowBanding).Shading.BackgroundPatternColor = wdColorAutomatic
      'Set the table alignment
      .Alignment = wdAlignRowCenter
      'Set how many rows & columns to group for banding
      .RowStripe = 1
      .ColumnStripe = 0
    End With
  End With
End With
End Sub

Having run that macro once, you can then add tables employing that style with code like:

Code:

Sub AddTable()
Dim Tbl As Table
'Create a basic 4-row 3-column table that autofits the column width
Set Tbl = ActiveDocument.Tables.Add(Range:=Selection.Characters.Last, NumRows:=4, NumColumns:=3, DefaultTableBehavior:=wdWord8TableBehavior)
With Tbl
  'Make the first row repeat is the table spans a page break
  .Rows.First.HeadingFormat = True
  'Set the row height rules
  .Rows.HeightRule = wdRowHeightAtLeast
  .Rows.Height = InchesToPoints(0.25)
  'Apply the Academic Style
  .Style = "Academic"
  'Apply the row banding
  .ApplyStyleRowBands = True
End With
End Sub

If you look through the code, you should be able to see where you might modify it to change the appearance & formatting of the tables that get created.