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
CodePudding user response:
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