Resize text box to the width of the containing text

[kmcbest]

Greetings everyone. I often have a lot of text boxes to fit into some tiny spaces. These boxes are copied from other collegues' slides, there is always some extra space to the both side of the text. Since I have restricted space, I need to somehow narrow down the box horiozontally so that the edges nearly touch the text (but not too narrow so the text wraps into another line).
Like this:
30581

I was thinking about resize the shape to the containing text width (in pixel or cm) based on the number of characters (calculated against the font size). But there are two problems:
1. The text is not in a monospaced font, so we can't simply multiply the character count with some constant value.
2. The "font size in cm" metric may vary from font to font, so it isn't reliable either.

What I need is to find out the actual text width within a shape (if the text is on one line)
30582
I did some search for "POWERPOINT calculate text width" but I think the keywords aren't getting me anywhere near what I need. So I'm asking if it is possible to determine the actual width of a given text.

Please help!

[kmcbest]

I think I found the property: it's boundwidth in the textrange object, so basically we can do something like this:



Sub ShrinkShapeToTextWidth()

For Each iter In ActiveWindow.Selection.ShapeRange
iter.Width = iter.TextFrame.TextRange.BoundWidth
Next

End Sub

[John Wilson]

Basically but I would add a little more code.


Sub ShrinkShapeToTextWidth()
Dim iter As Shape
For Each iter In ActiveWindow.Selection.ShapeRange
If iter.HasTextFrame Then
If iter.TextFrame2.HasText Then
With iter.TextFrame2
.WordWrap = False
.AutoSize = msoAutoSizeNone
End With
iter.Width = iter.TextFrame2.TextRange.BoundWidth
End If
End If
Next iter
End Sub