Resize text box to the width of the containing text

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:
Attachment 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)
Attachment 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!

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

Code:

---

Sub ShrinkShapeToTextWidth()

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

End Sub

---

Basically but I would add a little more code.

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

---