Powerpoint VBA - Distribute columns evenly

Question

I am using PowerPoint 2000 which does not have the distribute columns evenly function that 2003 and newer has. Does anyone know what VBA code would be used to distribute selected table columns evenly?

(I know how to do it for the WHOLE table by finding the table width, dividing it by the number of columns, and adjusting each column's width to that divided width. However, I am having problems applying it only to a selection. E.g. right 5 columns in a 7 column table.)

Answer 1

Take the sum of the widths of the columns that you're trying to distribute, then divide by the number of columns.

Answer 2

This will do the trick for you. Just ensure you have columns selected when you run this.

Sub DistributeSelectedColumnsEvenly()
Dim sel As Selection
Set sel = ActiveWindow.Selection
Dim fColumn As Integer
fColumn = 0
Dim lColumn As Integer
Dim columnsWidth As Integer

With sel
    If .Type = ppSelectionShapes Then
        If .ShapeRange.Type = msoTable Then
            Dim tbl As Table
            Set tbl = .ShapeRange.Table
            Dim tblColumnCount As Integer
            tblColumnCount = tbl.Columns.Count
            For colNum = 1 To tblColumnCount
                If tbl.Cell(1, colNum).Selected Then
                columnsWidth = columnsWidth + tbl.Cell(1, colNum).Parent.Columns(colNum).Width
                    If fColumn = 0 Then
                        fColumn = colNum
                    End If
                    lColumn = colNum
                End If
            Next
            Dim columnCount As Integer
            columnCount = (lColumn - fColumn) + 1
            Dim columnWidth As Integer
            columnWidth = columnsWidth / columnCount
            For columnIndex = fColumn To lColumn
                tbl.Columns(columnIndex).Width = columnWidth
            Next
        End If
    End If
End With
End Sub

Answer 3

Many thanks Otaku. Your subroutine works!