Artistic text--fit to frame?

Is there a way to make Artistic text "fit to frame" automatically?

I know you can make paragraph text fit to frame, but I need to be able to make artistic text fill a rectangle, as shown in the attached image.

Thanks,

Trenton

Parents
  • Here's a macro you could try:

    fit_A_into_B.zip

    The .GMS file has been wrapped in a .ZIP so that the forum software will allow the upload.

    1. Select the to-be-fitted object (e.g., the Artistic Text)
    2. Add the reference object (e.g., the Rectangle) to the selection.
    3. Run the macro.

    The code looks like this:

    Sub fit_A_into_B()
    Dim sr As ShapeRange
    Dim sToScale As Shape
    Dim sRef As Shape
    Dim dblScaleFactor As Double
    
        On Error GoTo ErrHandler
        ActiveDocument.BeginCommandGroup "fit A into B"
        
        Set sr = ActiveSelectionRange
        If sr.Count < 2 Or sr.Count > 2 Then
            MsgBox "Exactly two objects must be selected.", vbInformation, "fit_A_into_B"
            GoTo ExitSub
        End If
        
        Set sRef = sr(1)
        Set sToScale = sr(2)
        
        If sRef.SizeWidth / sRef.SizeHeight > sToScale.SizeWidth / sToScale.SizeHeight Then
            'scale to match height
            dblScaleFactor = sRef.SizeHeight / sToScale.SizeHeight
        Else
            'scale to match width
            dblScaleFactor = sRef.SizeWidth / sToScale.SizeWidth
        End If
        
        sToScale.SizeWidth = sToScale.SizeWidth * dblScaleFactor
        sToScale.SizeHeight = sToScale.SizeHeight * dblScaleFactor
        sToScale.CenterX = sRef.CenterX
        sToScale.CenterY = sRef.CenterY
        
    ExitSub:
        ActiveDocument.EndCommandGroup
        Exit Sub
    
    ErrHandler:
        MsgBox "Error occured: " & Err.Description & vbCrLf & vbCrLf & "fit_A_into_B"
        Resume ExitSub
    End Sub
    
Reply Children
No Data