martinctc
11/14/2017 - 2:44 PM

[Create Table Legend] Create a one-row mini table legend in PowerPoint #PowerPoint

[Create Table Legend] Create a one-row mini table legend in PowerPoint #PowerPoint

Sub TableLegend()

'Create a mini table legend (one-row, even-number of columns)
'Odd number columns are always small squares.
'Even number columns are for labels - therefore long rectangles


'r converts cm to points
r = 28.3464567

'ActiveWindow.Selection.ShapeRange.Top = 5.17 * r
'ActiveWindow.Selection.ShapeRange.Left = 1.67 * r

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

For j = 1 To ncol
    For i = 1 To nrow
        ActiveWindow.Selection.ShapeRange.Table.Cell(i, j).Shape.TextFrame.TextRange.Font.Size = 10
    Next
Next

ActiveWindow.Selection.ShapeRange.Table.Rows(1).Height = 0.6 * r

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

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

End Sub