martinctc
4/4/2017 - 3:55 PM

Make necessary tweaks to table objects to achieve consistency throughout slides. 12-06-17: A variation of the same script added.

Make necessary tweaks to table objects to achieve consistency throughout slides.

12-06-17: A variation of the same script added.

table_formatter.vbs
content_copyfile_download
Sub TableFormatter()

'r converts cm to points
r = 28.3464567

ncol = ActiveWindow.Selection.ShapeRange.Table.Columns.Count
nrow = ActiveWindow.Selection.ShapeRange.Table.Rows.Count



With ActiveWindow.Selection.ShapeRange
    .Left = 0.7 * r 'change the number for desired x position
    .Top = 1.57 * r 'change the number for desired y position
    .Table.Columns(1).Width = 11 * r
    .Table.Rows(1).Height = 1.5 * r
End With


For i = 2 To ncol
    ActiveWindow.Selection.ShapeRange.Table.Columns(i).Width = 2 * r
Next

For i = 2 To nrow
    ActiveWindow.Selection.ShapeRange.Table.Rows(i).Height = 0.43 * r
Next

End Sub
table tinkerer2.vbs
content_copyfile_download
Sub table_tinkerer2()

'r converts cm to points
r = 28.3464567

'Make general specifications on table position and size

With ActiveWindow.Selection.ShapeRange
    .Left = 14.29 * r 'change the number for desired x position
    .Top = 3.97 * r 'change the number for desired y position
    .Height = 6.81 * r
    .Width = 9.11 * r
    .Table.Columns(1).Width = 7.29 * r
    .Table.Rows(1).Height = 0.62 * r
    .Table.Columns(2).Width = 1.83 * r
End With

Dim i, j, k As Integer

'Loop through specific columns and rows

For j = 1 To 2
    For i = 1 To 11
        ActiveWindow.Selection.ShapeRange.Table.Cell(i, j).Shape.TextFrame.TextRange.Font.Size = 11
        ActiveWindow.Selection.ShapeRange.Table.Cell(i, j).Shape.TextFrame.TextRange.Font.Name = "Arial"
        ActiveWindow.Selection.ShapeRange.Table.Rows(i).Height = 0.62 * r
    Next
Next


End Sub
table tinkerer.vbs
content_copyfile_download
Sub table_tinkerer()

'r converts cm to points
r = 28.3464567

'Make general specifications on table position and size

With ActiveWindow.Selection.ShapeRange
    .Left = 1.31 * r 'change the number for desired x position
    .Top = 6.46 * r 'change the number for desired y position
    .Height = 9.58 * r
    .Width = 31.54 * r
    .Table.Columns(1).Width = 3.73 * r
    .Table.Rows(1).Height = 2.68 * r
    .Table.Columns(14).Width = 2.44 * r
End With

Dim i, j, k As Integer

'Loop through specific columns and rows

For j = 1 To 14
    ActiveWindow.Selection.ShapeRange.Table.Cell(j, j).Shape.TextFrame.TextRange.Font.Size = 11
    ActiveWindow.Selection.ShapeRange.Table.Cell(j, j).Shape.TextFrame.TextRange.Font.Name = "Calibri"
Next

'Loop through specific columns and rows

For i = 2 To 13
    ActiveWindow.Selection.ShapeRange.Table.Columns(i).Width = 2.12 * r
    ActiveWindow.Selection.ShapeRange.Table.Rows(i).Height = 0.53 * r
Next

'Loop through all the cells in a table

j = k = 1
    
For j = 1 To 14
    For k = 1 To 14
        ActiveWindow.Selection.ShapeRange.Table.Cell(j, k).Shape.TextFrame.TextRange.Font.Size = 11
        ActiveWindow.Selection.ShapeRange.Table.Cell(j, k).Shape.TextFrame.TextRange.Font.Name = "Calibri"
    Next
Next

End Sub