How to vba code "shrink text on overflow"?

[tangotom]

PowerPoint 2007 has a great text box formatting feature. Select a text
box > right click > Format Shape > Text Box > Autofit. One of the
options is, "Shrink text on overflow." So, when the user types in the
text box more text than will fit, the text box keeps its shape, and
the text font size gets smaller.

Has anyone figured out how to VBA code this? As part of
programmatically building a slide using form data that a user
supplies, I would like to be able to add a text box with the "Shrink
text on overflow" property.

Thanks for any help you can give.

Tom

 

[John Wilson]

Assuming that you have set otxtbox = the added text box

With otxtbox.TextFrame2
..WordWrap = True
..AutoSize = msoAutoSizeTextToFitShape
..TextRange = "The text to add"
End With
-------------------------------------------
Amazing PPT Hints, Tips and Tutorials

http://www.PPTAlchemy.co.uk
http://www.technologytrish.co.uk
email john AT technologytrish.co.uk

 

[tangotom]

Assuming that you have set otxtbox = the added text box

With otxtbox.TextFrame2
.WordWrap = True
.AutoSize = msoAutoSizeTextToFitShape
.TextRange = "The text to add"
End With
-------------------------------------------
Amazing PPT Hints, Tips and Tutorials

http://www.PPTAlchemy.co.ukhttp://www.technologytrish.co.uk
email john AT technologytrish.co.uk








- Show quoted text -

Thanks for responding, John. At least one thing I learned from it is
the existence of the TextFrame2 property! I had some success using
your method, but since I did not fully explain my need, it doesn't
quite do what I wanted. I would like the font in the text box to have
a default size of 44pt. Then, if the text submitted by the user
exceeds the text box, then it should shrink accordingly. With your
code, the font displays in a default size that is too small.

Here is my original code:

[strTitle passed to sub]
Dim shpTextBox As Shape

With ActiveWindow.View.Slide
Set shpTextBox = .Shapes.AddTextbox _
(Orientation:=msoTextOrientationHorizontal, Left:=0,
Top:=0, _
Width:=725, Height:=109)

With shpTextBox.TextFrame.TextRange
.Text = strTitle
.Font.Name = "Tahoma"
.Font.Size = 44
.Font.Bold = msoTrue
.Font.Shadow = msoTrue
.Font.Color.RGB = RGB(255, 255, 0) 'yellow
End With
End With

Is there a way I can have my default font format with
msoAutoSizeTextToFitShape? I also saw that with the TextRange2
property, I could not adjust the color or bold or shadow.

Thanks.

Tom

 

[tangotom]

Assuming that you have set otxtbox = the added text box

With otxtbox.TextFrame2
.WordWrap = True
.AutoSize = msoAutoSizeTextToFitShape
.TextRange = "The text to add"
End With

http://www.PPTAlchemy.co.ukhttp://www.technologytrish.co.uk
email john AT technologytrish.co.uk

- Show quoted text -

Thanks for responding, John.  At least one thing I learned from it is
the existence of the TextFrame2 property! I had some success using
your method, but since I did not fully explain my need, it doesn't
quite do what I wanted.  I would like the font in the text box to have
a default size of 44pt.  Then, if the text submitted by the user
exceeds the text box, then it should shrink accordingly. With your
code, the font displays in a default size that is too small.

Here is my original code:

    [strTitle passed to sub]
    Dim shpTextBox As Shape

    With ActiveWindow.View.Slide
        Set shpTextBox = .Shapes.AddTextbox _
            (Orientation:=msoTextOrientationHorizontal, Left:=0,
Top:=0, _
            Width:=725, Height:=109)

        With shpTextBox.TextFrame.TextRange
            .Text = strTitle
            .Font.Name = "Tahoma"
            .Font.Size = 44
            .Font.Bold = msoTrue
            .Font.Shadow = msoTrue
            .Font.Color.RGB = RGB(255, 255, 0) 'yellow
        End With
    End With

Is there a way I can have my default font format with
msoAutoSizeTextToFitShape?  I also saw that with the TextRange2
property, I could not adjust the color or bold or shadow.

Thanks.

Tom- Hide quoted text -

- Show quoted text -

I figured it out. To get default format *and* shrinking text, I used
both the TextRange and the TextRange2 properties:

[strTitle passed to sub]
Dim shpTextBox As Shape

With ActiveWindow.View.Slide

'Add the title text box
Set shpTextBox = .Shapes.AddTextbox _
(Orientation:=msoTextOrientationHorizontal, Left:=0,
Top:=0, _
Width:=725, Height:=109)

With shpTextBox.TextFrame.TextRange
.Text = strTitle
.Font.Name = "Tahoma"
.Font.Size = 44
.Font.Bold = msoTrue
.Font.Shadow = msoTrue
.Font.Color.RGB = RGB(255, 255, 0) 'yellow
End With

With shpTextBox.TextFrame2
.WordWrap = msoTrue
.AutoSize = msoAutoSizeTextToFitShape
End With
End With

Thanks again for your help John.

Tom

 

[John Wilson]

Thanks for getting back with your solution. As you figured out TextRange2 is
for the new 2007 properties
--
-------------------------------------------
Amazing PPT Hints, Tips and Tutorials

http://www.PPTAlchemy.co.uk
http://www.technologytrish.co.uk
email john AT technologytrish.co.uk

Assuming that you have set otxtbox = the added text box

With otxtbox.TextFrame2
.WordWrap = True
.AutoSize = msoAutoSizeTextToFitShape
.TextRange = "The text to add"
End With

http://www.PPTAlchemy.co.ukhttp://www.technologytrish.co.uk
email john AT technologytrish.co.uk

:
PowerPoint 2007 has a great text box formatting feature. Select a text
box > right click > Format Shape > Text Box > Autofit. One of the
options is, "Shrink text on overflow." So, when the user types in the
text box more text than will fit, the text box keeps its shape, and
the text font size gets smaller.

Has anyone figured out how to VBA code this? As part of
programmatically building a slide using form data that a user
supplies, I would like to be able to add a text box with the "Shrink
text on overflow" property.

Thanks for any help you can give.

Tom- Hide quoted text -

- Show quoted text -

Thanks for responding, John. At least one thing I learned from it is
the existence of the TextFrame2 property! I had some success using
your method, but since I did not fully explain my need, it doesn't
quite do what I wanted. I would like the font in the text box to have
a default size of 44pt. Then, if the text submitted by the user
exceeds the text box, then it should shrink accordingly. With your
code, the font displays in a default size that is too small.

Here is my original code:

[strTitle passed to sub]
Dim shpTextBox As Shape

With ActiveWindow.View.Slide
Set shpTextBox = .Shapes.AddTextbox _
(Orientation:=msoTextOrientationHorizontal, Left:=0,
Top:=0, _
Width:=725, Height:=109)

With shpTextBox.TextFrame.TextRange
.Text = strTitle
.Font.Name = "Tahoma"
.Font.Size = 44
.Font.Bold = msoTrue
.Font.Shadow = msoTrue
.Font.Color.RGB = RGB(255, 255, 0) 'yellow
End With
End With

Is there a way I can have my default font format with
msoAutoSizeTextToFitShape? I also saw that with the TextRange2
property, I could not adjust the color or bold or shadow.

Thanks.

Tom- Hide quoted text -

- Show quoted text -

I figured it out. To get default format *and* shrinking text, I used
both the TextRange and the TextRange2 properties:

[strTitle passed to sub]
Dim shpTextBox As Shape

With ActiveWindow.View.Slide

'Add the title text box
Set shpTextBox = .Shapes.AddTextbox _
(Orientation:=msoTextOrientationHorizontal, Left:=0,
Top:=0, _
Width:=725, Height:=109)

With shpTextBox.TextFrame.TextRange
.Text = strTitle
.Font.Name = "Tahoma"
.Font.Size = 44
.Font.Bold = msoTrue
.Font.Shadow = msoTrue
.Font.Color.RGB = RGB(255, 255, 0) 'yellow
End With

With shpTextBox.TextFrame2
.WordWrap = msoTrue
.AutoSize = msoAutoSizeTextToFitShape
End With
End With

Thanks again for your help John.

Tom