Resize text of selected shapes

[juanbolas]

Hello

I'm trying to resize the text of the selected shapes in the current slide.

Sub ResizeFont(Optional FontSize As Integer)
With ActiveWindow.Selection
    If .Type = ppSelectionShapes Then
    .TextFrame.textRange.Font.Size = 8
    End If
End With
End Sub

The (Optional FontSize As Integer) is to be able to pass different font sizes from a set of buttons with the desired font side I've created on a custom ribbon.

The code runs, I get no error, but it does nothing.

Thanks in advance for your help.

[John Wilson]

With ActiveWindow.Selection    If .Type = ppSelectionShapes Then
    .ShapeRange.TextFrame.TextRange.Font.Size = 8
    End If
End With

[juanbolas]

Works like a charm! Thanks John!

[juanbolas]

I added some error checking and tried to polish up the code a bit

Sub test()
ResizeText 10
End Sub


Sub ResizeText(Optional shFontSize As Integer)
Dim oShape
On Error GoTo CheckErrors
With ActiveWindow.Selection.ShapeRange
    If .Count = 0 Then
        MsgBox "You need to select a shape first"
        Exit Sub
    End If
End With
For Each oShape In ActiveWindow.Selection.ShapeRange
    oShape.TextFrame.textRange.Font.Size = shFontSize
Next
Exit Sub
CheckErrors: MsgBox Err.Description
End Sub

But now I realize it doesn't work with grouped shapes.

Any ideas on how I can proceed?

Thanks in advance!

[John Wilson]

Try this

PS always test that the shape has a textframe as it might be e.g. a picture and the code will fail

Sub test()    
ResizeText 10
End Sub


Sub ResizeText(Optional shFontSize As Integer)

    Dim oShape As Shape
    Dim L      As Long
    On Error GoTo CheckErrors
    With ActiveWindow.Selection.ShapeRange
        If .Count = 0 Then
            MsgBox "You need to select a shape first"
            Exit Sub
        End If
    End With
    For Each oShape In ActiveWindow.Selection.ShapeRange
        If oShape.Type = msoGroup Then
            For L = 1 To oShape.GroupItems.Count
                If oShape.GroupItems(L).HasTextFrame Then oShape.GroupItems(L).TextFrame.TextRange.Font.Size = shFontSize
            Next
        Else
            If oShape.HasTextFrame Then oShape.TextFrame.TextRange.Font.Size = shFontSize
        End If
    Next
    Exit Sub
CheckErrors:     MsgBox Err.Description
End Sub

[juanbolas]

Idol!
Thank you!