Using VBA how do I align the selected text to the middle vertically and center of a table cell?

Question

I'm using MacOS or I would have tried the Macro recorder :(

I have a regular repetitive task to change the selected text at various positions within multiple tables to a set font and size as well as centered within the table and vertically in the middle. Rather than do this a thousand times a week I am trying to make a macro to do it for me with VBA.

So far I have the font and text size changing whatever text is selected but can't seem to figure out the alignment with my friend Google.

Sub SR()

With ActiveWindow.Selection.TextRange2.Font
    .Name = "Roboto Light (Body)"
    .Size = "10"
End With

End Sub

Solution:

Sub SR()
    Dim oTbl As Table
    Dim oSh As Shape
    Dim lRow As Long
    Dim lCol As Long
    
    ' Get a reference to the parent table
    With ActiveWindow.Selection.ShapeRange(1).Table
        ' Find the selected cell
        For lRow = 1 To .Rows.Count
        For lCol = 1 To .Columns.Count
            If .Cell(lRow, lCol).Selected Then
                With .Cell(lRow, lCol).Shape.TextFrame2
                    .HorizontalAnchor = msoAnchorCenter
                    .VerticalAnchor = msoAnchorMiddle
                End With
                With .Cell(lRow, lCol).Shape.TextFrame2.TextRange.Font
                        .Name = "Roboto Light (Body)"
                        .Size = "10"
                End With
            End If
        Next
        Next
    
    End With

End Sub

Answer 1

Combine this with what you have and it should get you there.

You can set font and other characteristics of selected text, but to change the alignment, you need to work with the shape that contains the text. Normally you could walk up the selected text's Parent chain to get the containing shape, but unfortunately, that doesn't work with text in table cells. PPTBug.

Instead, you have to look at each cell to find out whether it's selected and if so, drill down to its shape. Which is what we do here.

By the way, no version of PPT has a macro recorder any longer, not even Windows.

Sub Test()

    Dim oTbl As Table
    Dim oSh As Shape
    Dim lRow As Long
    Dim lCol As Long
    
    ' Get a reference to the parent table
    With ActiveWindow.Selection.ShapeRange(1).Table
        ' Find the selected cell
        For lRow = 1 To .Rows.Count
        For lCol = 1 To .Columns.Count
            If .Cell(lRow, lCol).Selected Then
                With .Cell(lRow, lCol).Shape.TextFrame2
                    .HorizontalAnchor = msoAnchorCenter
                    .VerticalAnchor = msoAnchorMiddle
                End With
            End If
        Next
        Next
    
    End With
    
End Sub