Consulting

Results 1 to 6 of 6

Thread: Resize text of selected shapes

  1. #1

    Resize text of selected shapes

    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.
    Last edited by Aussiebear; 01-11-2022 at 11:12 AM. Reason: Added code tags to suppled code

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,043
    Location
    With ActiveWindow.Selection    If .Type = ppSelectionShapes Then
        .ShapeRange.TextFrame.TextRange.Font.Size = 8
        End If
    End With
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    Works like a charm! Thanks John!

  4. #4
    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!

  5. #5
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,043
    Location
    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
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  6. #6
    Idol!
    Thank you!

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •