This is a moderately generic macro to clean up tables.
Sub tfixtest() ' ' tfixtest Macro ' On Error GoTo ErrorHandler Selection.Tables(1).Select Selection.Rows.HeightRule = wdRowHeightAuto Selection.Rows.AllowBreakAcrossPages = False ' Selection.SelectCell Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft With Selection.ParagraphFormat ' .RightIndent = InchesToPoints(0) ' .LeftIndent = InchesToPoints(0) .SpaceBefore = 1 .SpaceBeforeAuto = False .SpaceAfter = 1 .SpaceAfterAuto = False .CharacterUnitRightIndent = 0 End With Selection.Cells.VerticalAlignment = wdCellAlignVerticalTop Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow) Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow) Selection.Font.Name = "Arial" Selection.Font.Size = 10 With Selection.Tables(1) .TopPadding = InchesToPoints(0.04) .BottomPadding = InchesToPoints(0.04) .LeftPadding = InchesToPoints(0.06) .RightPadding = InchesToPoints(0.06) .Spacing = 0 .AllowPageBreaks = True .AllowAutoFit = True End With ' Selection.Style = ActiveDocument.Styles("Table Text Left (Alt-T)") ErrorHandler: End Sub
Below is some stuff that I was messing with but isn’t fully sorted out yet.
Sub tablefun() Dim oTable As Table Dim oCell As Variant oTable.Select For Each oCell In oTable.Range.Cells oCell.Width = InchesToPoints(1) oCell.Shading.BackgroundPatternColorIndex = wdBlue oCell.Range.Font.Name = "Arial" oCell.Range.Font.Size = 20 oCell.Text = "ack" Next oCell End Sub Sub FixAllTables() Dim tbl As Table For Each tbl In ActiveDocument.Tables Selection.Tables(1).Select ' For Each oCell In oTable.Range.Cells ' oCell.Width = InchesToPoints(1) ' oCell.Shading.BackgroundPatternColorIndex = wdBlue ' oCell.Range.Font.Name = "Arial" ' oCell.Range.Font.Size = 20 ' Next oCell Selection.Tables(1).Select With tbl.Cells(1) ' With Selection.Cells(1) .VerticalAlignment = wdCellAlignVerticalTop .TopPadding = InchesToPoints(0.06) .BottomPadding = InchesToPoints(0.06) .LeftPadding = InchesToPoints(0.04) .RightPadding = InchesToPoints(0.04) .WordWrap = False .FitText = False End With Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow) Selection.Rows.HeightRule = wdRowHeightAuto Selection.Rows.Height = InchesToPoints(0) Selection.Rows.AllowBreakAcrossPages = False Next End Sub
Leave a Reply