Text fit properly within different size shapes to its maximum size using vba code.

[dibyendu2280]

Sir, need some help to configure emoji(as a text) to properly fit(cover almost shape size but not overflow) into different size shapes.
I tried to give some fix font size like 700 & then apply "msoAutoSizeTextToFitShape" but it overflow the shape boundary.
For better understanding I uploaded sample file where I showed the final outcome.
Any solution will be highly appreciated.



Sub proper_fit()


Dim shpImage As Shape
Set shpImage = ActivePresentation.Slides(1).Shapes("shape1")
With shpImage
.TextFrame.TextRange.Font.Size = 700
.TextFrame2.AutoSize = msoAutoSizeTextToFitShape
End With


End Sub

[Aussiebear]

Maybe try this



Sub proper_fit()
Dim shpImage As Shape
Set shpImage = ActivePresentation.Slides(1).Shapes("shape1")
With shpImage
.TextFrame2.TextRange.Font.Size = 700
.TextFrame2.AutoSize = msoAutoSizeTextToFitShape
End With
End Sub


and then try adjusting the font size downwards

[dibyendu2280]

sir, how to adjust font size with code downwards so that it properly fit for that size shape?

[dibyendu2280]

Find this thread to get idea & its working: Autosize Text in a Shape - one line (http://www.vbaexpress.com/forum/showthread.php?61738-Autosize-Text-in-a-Shape-one-line) Thanks to @Jhon Wilson sir.

[John Wilson]

You might want to play with this code too.

Sub adjust2Fit()
Dim oshp As Shape
Set oshp = ActiveWindow.Selection.ShapeRange(1)
With oshp.TextFrame2
.TextRange.Font.Size = 100
.AutoSize = msoAutoSizeShapeToFitText
.MarginLeft = 0
.MarginRight = 0
End With
oshp.Width = oshp.TextFrame2.TextRange.BoundWidth
End Sub

[Aussiebear]

Thank you John.