iappyx / Instrumenta

Free and open source consulting-style Powerpoint toolbar
MIT License
251 stars 20 forks source link

Different way of aligning shapes to table #7

Closed Marmootje closed 3 years ago

Marmootje commented 3 years ago

Hi,

I was thinking about the Align objects to table feature and I have written some lines of code based on your module. My solution gives a bit more freedom in my opinion and makes it simpler to use. It makes it possible to align to rows and columns at the same time. It works by looping through each shape and determines to which table cell the shape should be aligned based on the centre of the respective shape. This means the shapes should already be positioned over the table but in my experience this is usually the case anyway. I am submitting this so you could add it to the toolbar if you like the solution.

Thanks again for the amazing add in and I hope I can contribute a bit this way.

` Sub ObjectsAlignToTable()

Set myDocument = Application.ActiveWindow

Dim ShapeCount  As Long
Dim TableNum As Long
'Loop through all selected shapes to determine which is the table (if multiple tables are selected, the shapes will be aligned to the first one
For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count
    If myDocument.Selection.ShapeRange(ShapeCount).HasTable = True Then
        TableNum = ShapeCount
        Exit For
    End If
Next ShapeCount
'Do not execute if no table is selected
If TableNum >= 1 Then

    Dim SlideShape() As Shape
    ReDim SlideShape(1 To myDocument.Selection.ShapeRange.Count - 1)
    Dim Counter As Integer

    Counter = 1

    For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count
        If ShapeCount <> TableNum Then
            Set SlideShape(Counter) = myDocument.Selection.ShapeRange(ShapeCount)
            Counter = Counter + 1
        End If
    Next ShapeCount

    Dim Rows As Integer, Cols As Integer

    Rows = myDocument.Selection.ShapeRange(TableNum).Table.Rows.Count
    Cols = myDocument.Selection.ShapeRange(TableNum).Table.Columns.Count

    Dim XBorder As Double, YBorder As Double
    Dim TableCols() As Double, TableRows() As Double
    Dim XCenter() As Double, YCenter() As Double

    ReDim TableCols(Cols), TableRows(Rows)
    ReDim XCenter(1 To Cols), YCenter(1 To Rows)

    XBorder = myDocument.Selection.ShapeRange(TableNum).Left
    YBorder = myDocument.Selection.ShapeRange(TableNum).Top

    TableRows(0) = YBorder
    TableCols(0) = XBorder

    'Loop through each row in the table and store the bottom border and the centerpoint in arrays
    For RowN = 1 To Rows
        YBorder = YBorder + myDocument.Selection.ShapeRange(TableNum).Table.Rows(RowN).Height
        TableRows(RowN) = YBorder
        YCenter(RowN) = YBorder - (myDocument.Selection.ShapeRange(TableNum).Table.Rows(RowN).Height / 2)
    Next RowN

    'Loop through each row in the table and store the bottom border and the centerpoint in arrays
    For ColN = 1 To Cols
        XBorder = XBorder + myDocument.Selection.ShapeRange(TableNum).Table.Columns(ColN).Width
        TableCols(ColN) = XBorder
        XCenter(ColN) = XBorder - (myDocument.Selection.ShapeRange(TableNum).Table.Columns(ColN).Width / 2)
    Next ColN

    'Loop over each selected shape (excluding the table)
    For ShapeCount = 1 To myDocument.Selection.ShapeRange.Count - 1
        'Determine the center of each shape
        ShapeXCenter = SlideShape(ShapeCount).Left + (SlideShape(ShapeCount).Width / 2)
        ShapeYCenter = SlideShape(ShapeCount).Top + (SlideShape(ShapeCount).Height / 2)

        'Loop through each row to determine which row the shape should be aligned to
        For RowN = 1 To Rows
            'Compare the shape centerpoint to the row borders
            If ShapeYCenter >= TableRows(RowN - 1) And ShapeYCenter < TableRows(RowN) Then
                'Align the shape to the row
                SlideShape(ShapeCount).Top = YCenter(RowN) - (SlideShape(ShapeCount).Height / 2)
                Exit For
            End If
        Next RowN

        'Loop through each column to determine which column the shape should be aligned to
        For ColN = 1 To Cols
            If ShapeXCenter >= TableCols(ColN - 1) And ShapeXCenter < TableCols(ColN) Then
                'Align the shape to the column
                SlideShape(ShapeCount).Left = XCenter(ColN) - (SlideShape(ShapeCount).Width / 2)
                Exit For
            End If
        Next ColN
    Next ShapeCount

Else

    MsgBox "No table selected. Please select a table."

End If

End Sub `

iappyx commented 3 years ago

Thanks! That's very nice. Was thinking about this too, but did not have time to detail it out. Very nice solution. WIll test it and add it. Think I will keep the other implementation (as there are use cases for those) but make this the first option/button in the ribbon.

iappyx commented 3 years ago

Thanks again! It's now included in the latest version with some updates. Updated it a little bit so it also works for small tables that are used as shape. If multiple tables are selected the largest (or for the other functions widest/highest) table is the one used for alignment. Also included some additional error handling.