toddvoros
asked on
How to get ScaleWidth and ScaleHeight for a Textbox in PowerPoint?
Need an example of VBA code to get ScaleHeight and ScaleWidth for an existing TextBox on a Slide
in PowerPoint? Retrieving Height and Width and rescaling only works for Pictures and OLE objects,
not TextBoxes. There must be some way to do this, but is is not obvious.
in PowerPoint? Retrieving Height and Width and rescaling only works for Pictures and OLE objects,
not TextBoxes. There must be some way to do this, but is is not obvious.
Lovely bit of code, Hippohood.
ASKER
I need to RETRIEVE the ScaleWidth / ScaleHeight from an EXISTING TextFrame from a presenation
that I did not create. The code you supplied (which I am already familiar with) only shows how
to SET the scaling for the TextFrame, not how to retrieve it.
that I did not create. The code you supplied (which I am already familiar with) only shows how
to SET the scaling for the TextFrame, not how to retrieve it.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
BoundHeight and BoundWidth does not give me what I need. Here is what I need.
In PowerPoint, a Textbox has been created originally that looks like this
where *** represents the border lines:
******************
* A text string *
******************
The user then extends the lines surrounding the Text box like this:
************************** ********** ********** ****
* A text string *
************************** ********** ********** ****
Internally, this is typically done by
ActiveWindow.Selection.Sha peRange.Sc aleWidth 1.55, msoFalse, msoScaleFromTopLeft
(where 1.55 is the scaling factor for the increase in the width of the text box)
What is delivered to me in a presentation is the streched textbox.
I need the code that RECOVERS the value of 1.55 (the original ScaleWidth factor).
Thank you for your help on this. I had hoped that BoundWidth would do this,
but BoundWidth does not change at all when the textbox is streched, so I
cannot recover the orginal ScaleWidth factor via object.TextFrame.TextRange .BoundWidt h.
In PowerPoint, a Textbox has been created originally that looks like this
where *** represents the border lines:
******************
* A text string *
******************
The user then extends the lines surrounding the Text box like this:
**************************
* A text string *
**************************
Internally, this is typically done by
ActiveWindow.Selection.Sha
(where 1.55 is the scaling factor for the increase in the width of the text box)
What is delivered to me in a presentation is the streched textbox.
I need the code that RECOVERS the value of 1.55 (the original ScaleWidth factor).
Thank you for your help on this. I had hoped that BoundWidth would do this,
but BoundWidth does not change at all when the textbox is streched, so I
cannot recover the orginal ScaleWidth factor via object.TextFrame.TextRange
But you should be able to recover it from the shape.
"All positional/dimensional properties behave exactly identical to the properties of the parent shape"
"All positional/dimensional properties behave exactly identical to the properties of the parent shape"
ASKER
Give me a specific code example
ASKER
This code would provide the answer EXCEPT you cannot use it on a TextRange, darn it!!
It only works on Pictures or OLE objects. So I need code similar to this that WILL work for a TextRange.
Dim CurrentWidth As Single
Dim OriginalWidth As Single
Dim ShapeType As String
CurrentWidth = ppShape.Width
ppShape.ScaleWidth 1, True
OriginalWidth = ppShape.Width
PowerPointScaleWidth = CurrentWidth / OriginalWidth
Rem Rescale the object back to it's scaled Width:
ppShape.ScaleWidth PowerPointScaleWidth, True
Whatever solution is provided, I need a specific code example to test. Thank you.
It only works on Pictures or OLE objects. So I need code similar to this that WILL work for a TextRange.
Dim CurrentWidth As Single
Dim OriginalWidth As Single
Dim ShapeType As String
CurrentWidth = ppShape.Width
ppShape.ScaleWidth 1, True
OriginalWidth = ppShape.Width
PowerPointScaleWidth = CurrentWidth / OriginalWidth
Rem Rescale the object back to it's scaled Width:
ppShape.ScaleWidth PowerPointScaleWidth, True
Whatever solution is provided, I need a specific code example to test. Thank you.
ASKER
Typo correction: Meant to say you cannot use it on a TEXTFRAME.
Perhaps you can use the parent property to get the info you need and return the parent shape to the original scalewidth and set the textframe width to the match the parent shape width or reset the textframe margins.
http://msdn2.microsoft.com/en-us/library/aa221481(office.11).aspx
Sorry, can't give you the code example, just not that good at it and don't have the time right now. Why I admire folks like Hippohood...
Glenna
http://msdn2.microsoft.com/en-us/library/aa221481(office.11).aspx
Sorry, can't give you the code example, just not that good at it and don't have the time right now. Why I admire folks like Hippohood...
Glenna
toddvoros
Sorry we didn't understand each other. I cite again the article from the VBA Help
____________
ScaleHeight Method
Scales the height of the shape by a specified factor. For pictures and OLE objects, you can indicate whether you want to scale the shape relative to the original size or relative to the current size. Shapes other than pictures and OLE objects are always scaled relative to their current height.
------------------
That means that information about original Textbox size is never stored, It makes sense, if you think about it. You just don't need it for Shapes, the are needed for hard-to-scale-back objects (Images and OLEs). Note, that you still would have uncertainty of the value of MsoScaleFrom.
You may try to get the original size back by the following ways:
1. Set the shape width eqaul to text width
aBox.Width= aBox.BoundWidth
2. If this textbox was on Master slide (doupt it) get it back to Master value
aBox.Width= .SlideMaster.Shapes("Recta ngle 1").Width
ActiveWindow.Selection.Sha peRange.Te xtFrame.Te xtRange.Se lect
========================== ========== ========== =
Glenna:
Greatly appreciate your note. A nice WEB site you have. Have used a few tricks of yours already.
Chears
Sorry we didn't understand each other. I cite again the article from the VBA Help
____________
ScaleHeight Method
Scales the height of the shape by a specified factor. For pictures and OLE objects, you can indicate whether you want to scale the shape relative to the original size or relative to the current size. Shapes other than pictures and OLE objects are always scaled relative to their current height.
------------------
That means that information about original Textbox size is never stored, It makes sense, if you think about it. You just don't need it for Shapes, the are needed for hard-to-scale-back objects (Images and OLEs). Note, that you still would have uncertainty of the value of MsoScaleFrom.
You may try to get the original size back by the following ways:
1. Set the shape width eqaul to text width
aBox.Width= aBox.BoundWidth
2. If this textbox was on Master slide (doupt it) get it back to Master value
aBox.Width= .SlideMaster.Shapes("Recta
ActiveWindow.Selection.Sha
==========================
Glenna:
Greatly appreciate your note. A nice WEB site you have. Have used a few tricks of yours already.
Chears
ASKER
Here is tested, verified solution which I wrote myself to get the ScaleWidth of a streched Textbox,
after much experimenting. The fact the empty textboxes have a default width that is independent
of the font specified must be taken into account when computing the ScaleWidth.
This is obscure and not documented anywhere that I could find. BoundWidth is needed to
derive ScaleWidth of the TextBox, so I will award the points to Glenna for pointing me to
the BoundWidth property. However, all of the code is my own.
Function PowerPointScaleWidth(Calle dby As String, ppShape As PowerPoint.Shape) As Single
On Error GoTo abort
Rem ************************** ********** ********** ********** *****
Rem * Compute the ScaleWidth for the specified PowerPoint shape *
Rem ************************** ********** ********** ********** *****
Rem Version A00 - 10-Apr-07 - Todd Voros - Initial version
Rem Version A01 - 10-Apr-07 - Todd Voros - Fix incorrect reference name for ppShape
Rem Version B00 - 10-Apr-07 - Todd Voros - Call PowerPointShapeType
Rem Version D00 - 11-Apr-07 - Todd Voros - Support TextBoxes (major enhancement)
Rem Version D01 - 11-Apr-07 - Todd Voros - Change PowerPointScaleWidth precission from Single to Double
Rem Version E00 - 11-Apr-07 - Todd Voros - Treat PlaceHolder Shape as a TextBox if it has a TextFrame
Rem Version F00 - 11-Apr-07 - Todd Voros - Round PowerPointScaleWidth to two decimal places
Dim CurrentWidth As Single
Dim BoundWidth As Single
Dim dblCurrentWidth As Double
Dim OriginalWidth As Double
Dim ShapeType As String
Const S_Edge = 15.25 ' Total Space in Width units for default Empty Textbox with Autofit applied
Dim Caller As String
Caller = "PowerPointScaleWidth"
CurrentWidth = ppShape.Width ' Must be retrieved into a Single.
dblCurrentWidth = CDbl(CurrentWidth) ' Convert Single to Double precission.
ShapeType = PowerPointShapeType(Caller , ppShape)
If (LCase$(ShapeType) = "textbox" Or (ppShape.HasTextFrame = True)) Then
Rem ************************** ********** ********** ********** *******
Rem * CurrentWidth is the actual width of the displayed border *
Rem * around the TextBox *after* any ScaleWidth has been applied. *
Rem ************************** ********** ********** ********** *******
BoundWidth = ppShape.TextFrame.TextRang e.BoundWid th
OriginalWidth = BoundWidth + S_Edge
PowerPointScaleWidth = dblCurrentWidth / OriginalWidth
PowerPointScaleWidth = Round(PowerPointScaleWidth , 2)
Else
msgbox("Object is not a textbox or does not have a TextFrame")
stop
End If
Exit Function
abort: Call dead("PowerPointScaleWidth ")
End Function
Function PowerPointShapeType(Called by As String, ppShape As PowerPoint.Shape) As String
On Error GoTo abort
Rem Return the type of Powerpoint Shape as a string
Rem Version A00 - 10-Apr-07 - Todd Voros - Initial version.
Dim ShapeCode As Long
Dim Caller As String
Caller = "PowerPointShapeType"
PowerPointShapeType = "" ' Indicate code not known
ShapeCode = ppShape.Type ' Get the Shape code
If ShapeCode = msoAutoShape Then PowerPointShapeType = "AutoShape"
If ShapeCode = msoCanvas Then PowerPointShapeType = "Canvas"
If ShapeCode = msoComment Then PowerPointShapeType = "Comment"
If ShapeCode = msoFormControl Then PowerPointShapeType = "FormControl"
If ShapeCode = msoCallout Then PowerPointShapeType = "Callout"
If ShapeCode = msoFormControl Then PowerPointShapeType = "FormControl"
If ShapeCode = msoChart Then PowerPointShapeType = "Chart"
If ShapeCode = msoEmbeddedOLEObject Then PowerPointShapeType = "EmbeddedOLEObject"
If ShapeCode = msoFreeform Then PowerPointShapeType = "msoFreeform"
If ShapeCode = msoGroup Then PowerPointShapeType = "Group"
If ShapeCode = msoLine Then PowerPointShapeType = "Line"
If ShapeCode = msoLinkedOLEObject Then PowerPointShapeType = "LinkedOLEObject"
If ShapeCode = msoLinkedPicture Then PowerPointShapeType = "LinkedPicture"
If ShapeCode = msoMedia Then PowerPointShapeType = "Media"
If ShapeCode = msoOLEControlObject Then PowerPointShapeType = "OLEControlObject"
If ShapeCode = msoPicture Then PowerPointShapeType = "Picture"
If ShapeCode = msoPlaceholder Then PowerPointShapeType = "Placeholder"
If ShapeCode = msoScriptAnchor Then PowerPointShapeType = "ScriptAnchor"
If ShapeCode = msoShapeTypeMixed Then PowerPointShapeType = "ShapeTypeMixed"
If ShapeCode = msoTable Then PowerPointShapeType = "Table"
If ShapeCode = msoTextBox Then PowerPointShapeType = "TextBox"
If ShapeCode = msoTextEffect Then PowerPointShapeType = "TextEffect"
If PowerPointShapeType = "" Then
MsgBox ("PowerPointShapeCode: Unknown Shape code " & ShapeCode)
Call dead(Caller)
End If
Exit Function
abort: Call dead("PowerPointShapeType" )
End Function
after much experimenting. The fact the empty textboxes have a default width that is independent
of the font specified must be taken into account when computing the ScaleWidth.
This is obscure and not documented anywhere that I could find. BoundWidth is needed to
derive ScaleWidth of the TextBox, so I will award the points to Glenna for pointing me to
the BoundWidth property. However, all of the code is my own.
Function PowerPointScaleWidth(Calle
On Error GoTo abort
Rem **************************
Rem * Compute the ScaleWidth for the specified PowerPoint shape *
Rem **************************
Rem Version A00 - 10-Apr-07 - Todd Voros - Initial version
Rem Version A01 - 10-Apr-07 - Todd Voros - Fix incorrect reference name for ppShape
Rem Version B00 - 10-Apr-07 - Todd Voros - Call PowerPointShapeType
Rem Version D00 - 11-Apr-07 - Todd Voros - Support TextBoxes (major enhancement)
Rem Version D01 - 11-Apr-07 - Todd Voros - Change PowerPointScaleWidth precission from Single to Double
Rem Version E00 - 11-Apr-07 - Todd Voros - Treat PlaceHolder Shape as a TextBox if it has a TextFrame
Rem Version F00 - 11-Apr-07 - Todd Voros - Round PowerPointScaleWidth to two decimal places
Dim CurrentWidth As Single
Dim BoundWidth As Single
Dim dblCurrentWidth As Double
Dim OriginalWidth As Double
Dim ShapeType As String
Const S_Edge = 15.25 ' Total Space in Width units for default Empty Textbox with Autofit applied
Dim Caller As String
Caller = "PowerPointScaleWidth"
CurrentWidth = ppShape.Width ' Must be retrieved into a Single.
dblCurrentWidth = CDbl(CurrentWidth) ' Convert Single to Double precission.
ShapeType = PowerPointShapeType(Caller
If (LCase$(ShapeType) = "textbox" Or (ppShape.HasTextFrame = True)) Then
Rem **************************
Rem * CurrentWidth is the actual width of the displayed border *
Rem * around the TextBox *after* any ScaleWidth has been applied. *
Rem **************************
BoundWidth = ppShape.TextFrame.TextRang
OriginalWidth = BoundWidth + S_Edge
PowerPointScaleWidth = dblCurrentWidth / OriginalWidth
PowerPointScaleWidth = Round(PowerPointScaleWidth
Else
msgbox("Object is not a textbox or does not have a TextFrame")
stop
End If
Exit Function
abort: Call dead("PowerPointScaleWidth
End Function
Function PowerPointShapeType(Called
On Error GoTo abort
Rem Return the type of Powerpoint Shape as a string
Rem Version A00 - 10-Apr-07 - Todd Voros - Initial version.
Dim ShapeCode As Long
Dim Caller As String
Caller = "PowerPointShapeType"
PowerPointShapeType = "" ' Indicate code not known
ShapeCode = ppShape.Type ' Get the Shape code
If ShapeCode = msoAutoShape Then PowerPointShapeType = "AutoShape"
If ShapeCode = msoCanvas Then PowerPointShapeType = "Canvas"
If ShapeCode = msoComment Then PowerPointShapeType = "Comment"
If ShapeCode = msoFormControl Then PowerPointShapeType = "FormControl"
If ShapeCode = msoCallout Then PowerPointShapeType = "Callout"
If ShapeCode = msoFormControl Then PowerPointShapeType = "FormControl"
If ShapeCode = msoChart Then PowerPointShapeType = "Chart"
If ShapeCode = msoEmbeddedOLEObject Then PowerPointShapeType = "EmbeddedOLEObject"
If ShapeCode = msoFreeform Then PowerPointShapeType = "msoFreeform"
If ShapeCode = msoGroup Then PowerPointShapeType = "Group"
If ShapeCode = msoLine Then PowerPointShapeType = "Line"
If ShapeCode = msoLinkedOLEObject Then PowerPointShapeType = "LinkedOLEObject"
If ShapeCode = msoLinkedPicture Then PowerPointShapeType = "LinkedPicture"
If ShapeCode = msoMedia Then PowerPointShapeType = "Media"
If ShapeCode = msoOLEControlObject Then PowerPointShapeType = "OLEControlObject"
If ShapeCode = msoPicture Then PowerPointShapeType = "Picture"
If ShapeCode = msoPlaceholder Then PowerPointShapeType = "Placeholder"
If ShapeCode = msoScriptAnchor Then PowerPointShapeType = "ScriptAnchor"
If ShapeCode = msoShapeTypeMixed Then PowerPointShapeType = "ShapeTypeMixed"
If ShapeCode = msoTable Then PowerPointShapeType = "Table"
If ShapeCode = msoTextBox Then PowerPointShapeType = "TextBox"
If ShapeCode = msoTextEffect Then PowerPointShapeType = "TextEffect"
If PowerPointShapeType = "" Then
MsgBox ("PowerPointShapeCode: Unknown Shape code " & ShapeCode)
Call dead(Caller)
End If
Exit Function
abort: Call dead("PowerPointShapeType"
End Function
Well thank you, sir. And thanks for writing and sharing the code that will be helpful for someone else who might have a related issue.
:-)
:-)
Text boxes have these properties see an example below. However, the scaling is applied to Text Frame only (you have to modify text to fit in the smaller box size). Also, you can keep "realtive to original" only for OLEs and pics. Citing: "Shapes other than pictures and OLE objects are always scaled relative to their current width".
The code below shows how to use this method and a way how to make the text to fit it in. Other ways can be imagined.
'=========================
Sub InsertNeatBox()
Dim aBox As Shape
Set aBox = ActiveWindow.Selection.Sli
With aBox.TextFrame.TextRange
.Text = "This is a box" + Chr$(CharCode:=13) + "with three" + Chr$(CharCode:=13) + "lines"
.Sentences
End With
MsgBox "Textbox created"
With aBox
.ScaleWidth 0.2, msoFalse
End With
MsgBox "Scaled down - text doesn't fit the box"
With aBox.TextFrame.TextRange
Do While ((.BoundHeight > aBox.Height) Or (.BoundWidth > aBox.Width))
.Font.Size = .Font.Size - 1
Loop
End With
MsgBox "Font size reduced to fit the box"
End Sub