PP Textbox Vertical Anchor problem

[Silvester]

I use vba automation to automate powerpoint from Access. I am having a
problem with PP vertical anchors in a textbox. I would like the text in the
textbox to appear at the bottom of the slide.

With the vba code below it appears off the screen on the top of the
screen...

Can someone please help me with this ??


-----------------------------------
On my new slide (ppLayoutBlank)
I would like to have a textbox say,
..AddTextbox msoTextOrientationHorizontal, 5#, 10#, 700#, 36#

With oslide.Shapes.Item(1).TextFrame.TextRange
.Text = "This should appear at the bottom of the slide"
.ParagraphFormat.Bullet.Type = ppBulletNone
With .Font
.Name = "Arial"
.Size = 28
.Bold = msoTrue
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoTrue
End With
End With

'Vertical Align = bottom
oSlide.Shapes.Item(1).TextFrame.VerticalAnchor = msoAnchorBottomBaseLine
oSlide..Shapes.Item(1).TextFrame.HorizontalAnchor = msoAnchorCenter

 

[Shyam Pillai]

Silvester,
If you want to align the shape at the bottom of the slide you need to use
the Align method to get it to work.

Dim oSlide As Slide
Dim oShp As Shape
Set oSlide = ActiveWindow.Selection.SlideRange(1)
Set oShp = oSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 5#,
10#, 700#, 36#)
With oShp.TextFrame.TextRange
.Text = "This should appear at the bottom of the slide"
.ParagraphFormat.Bullet.Type = ppBulletNone
With .Font
.Name = "Arial"
.Size = 28
.Bold = msoTrue
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoTrue
End With

End With
' ======================
With oSlide.Shapes.Range(oShp.ZOrderPosition)
.Align msoAlignBottoms, True
.Align msoAlignRights, True
End With
' ======================

 

[Silvester]

Thanks Shyam,

This works great with a single line of text but has problems when you add
more than one line. I'd like to be able to add multiple lines of text and
maybe have it display 1cm off the bottom edge of the slide.

Try this to see the problem...

'==================
' Start PowerPoint.
Dim ppApp As PowerPoint.Application
Set ppApp = CreateObject("Powerpoint.Application")

' Make it visible.
'ppApp.Visible = True

' Add a new presentation.
Dim ppPres As PowerPoint.Presentation
Set ppPres = ppApp.Presentations.Add(msoTrue)
ppPres.ExtraColors.Add RGB(Red:=0, Green:=51, Blue:=0)


' Add a new slide.

Dim oSlide As Slide
Set oSlide = ppPres.Slides.Add(1, ppLayoutBlank)


Dim oShp As Shape
'Set oSlide = ActiveWindow.Selection.SlideRange(1)
Set oShp = oSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 5#,
10#, 700#, 36#)
With oShp.TextFrame.TextRange
.Text = "1This should appear at the bottom of the slide" & vbCrLf &
"2This should appear at the bottom of the slide" & vbCrLf & "3This should
appear at the bottom of the slide"

.ParagraphFormat.Bullet.Type = ppBulletNone
With .Font
.Name = "Arial"
.Size = 28
.Bold = msoTrue
.Italic = msoFalse
.Underline = msoFalse
.Shadow = msoTrue
End With

End With
' ======================
With oSlide.Shapes.Range(oShp.ZOrderPosition)
.Align msoAlignBottoms, True
.Align msoAlignRights, True
End With
' ======================

ppPres.SlideShowSettings.Run
'=========================

 

[Shyam Pillai]

Silvester,
You need to check if the textframe bounds are larger than the parent shape
and resize accordingly.

With oShp
If .Width < .TextFrame.TextRange.BoundWidth Then
.Width = .TextFrame.TextRange.BoundWidth
End If
If .Height < .TextFrame.TextRange.BoundHeight Then
.Height = .TextFrame.TextRange.BoundHeight
End If
End With

 

[Shyam Pillai]

Steve,

It should work if you set the text box's textframe's .AutoSize property to
false immediately after adding the box but before adding text to it.

I avoid this method because I have never got it to work as expected.

' Consider:
'-------------------------------------------------
Dim oSlide As Slide
Dim oShp As Shape
Set oSlide = ActiveWindow.Selection.SlideRange(1)
Set oShp = oSlide.Shapes.AddShape(msoTextOrientationHorizontal, 0#, 0#,
700#, 36#)
oShp.TextFrame.AutoSize = ppAutoSizeNone
With oShp.TextFrame.TextRange
.Text = "1 This should appear at the bottom of the slide" & vbCrLf &
_
"2 This should appear at the bottom of the slide" &
vbCrLf
.ParagraphFormat.Bullet.Type = ppBulletNone
With .Font:
.Name = "Arial": .Size = 28: .Bold = msoTrue:
.Italic = msoFalse: .Underline = msoFalse: .Shadow = msoTrue
End With
End With

' Make shape increase to the text frame size
oShp.TextFrame.AutoSize = ppAutoSizeShapeToFitText
' You would expect the shape size to be encompass the text area,
' but it doesn't unless you either
' 1. Drag and move the shape to a new position in UI (not with VBA)
' 2. Double-click on the shape to bring up the format autoshape dialog
and click on OK.
'-------------------------------------------------
Hence I use the code snippet below:
'-------------------------------------------------
Dim oSlide As Slide
Dim oShp As Shape
Set oSlide = ActiveWindow.Selection.SlideRange(1)
Set oShp = oSlide.Shapes.AddShape(msoTextOrientationHorizontal, 0#, 0#,
700#, 36#)

With oShp.TextFrame.TextRange
.Text = "1 This should appear at the bottom of the slide" & vbCrLf &
_
"2 This should appear at the bottom of the slide"

.ParagraphFormat.Bullet.Type = ppBulletNone
With .Font
.Name = "Arial": .Size = 28: .Bold = msoTrue:
.Italic = msoFalse: .Underline = msoFalse: .Shadow = msoTrue
End With

End With
With oShp
If .Width < .TextFrame.TextRange.BoundWidth Then
.Width = .TextFrame.TextRange.BoundWidth
End If
If .Height < .TextFrame.TextRange.BoundHeight Then
.Height = .TextFrame.TextRange.BoundHeight
End If
End With
With oSlide.Shapes.Range(oShp.ZOrderPosition)
.Align msoAlignBottoms, True
.Align msoAlignRights, True
End With
'-------------------------------------------------
Do you see differently?

 

[Silvester]

Thanks very much Gentlemen.This works great...

I have added a oShp.Fill.Background to get rid of the textbox shape's green
colour.

The shape still retains a thin black border line. Is there any way I can get
rid of that ?



Maybe its just me

 

[Shyam Pillai]

Use oShp.Line.Visible =False

 

[Silvester]

Thanks Shyam,

That worked fine. Since PP's font shadows are not very effective -

What if I want to add a manual shadow - another identical textbox slightly
offset behind the first aligned textbox, maybe 5 points, in a dark colour.

With the current code a shape is obviously locked into position. How can I
tweak positions a bit to enable manual shadows ?