PDA

View Full Version : Solved: Add Textbox to an array of slides



twaintwist
07-03-2012, 06:38 AM
This is basic but I'm not sure how to index through a set of slides --- I'd like to add a textbox to the first four or five slides in an existing presentation programmatically.... here is what I have --- my code produces 4 copies of the text box on slide 1 instead of one textbox on Slide 1,2, 3, 4...... I know it's the 'Active.Window' that is incorrect but I'm not sure how to fix it....


Sub addTxtBox()
Dim oTextBox As Shape
Dim strText As String
Dim oSlide As Slide '* Slide Object
Dim sldCurrSlides As PowerPoint.SlideRange
Set sldCurrSlides = ActivePresentation.Slides.Range(Array(1, 2, 3, 4))

strText = "Replace this text with your analysis comments........."

For Each oSlide In ActivePresentation.Slides.Range(Array(1, 2, 3, 4))

'Add text box with text string.
Set oTextBox = ActiveWindow.Selection.SlideRange.Shapes.AddTextbox(msoTextOrientationHoriz ontal, 25, 575, 1050, 70)

With oTextBox
.Line.Visible = msoTrue
.Line.ForeColor.RGB = RGB(255, 0, 0)
.Line.BackColor.RGB = RGB(255, 255, 255)
.TextFrame.TextRange.Text = strText
.TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
.TextFrame.TextRange.Font.Name = "Arial"
.TextFrame.TextRange.Font.Size = "16"
.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignLeft
.TextFrame.TextRange.Select
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Fill.Transparency = 0#
.Line.Weight = 2#
End With
Next oSlide

End Sub

John Wilson
07-03-2012, 08:07 AM
Here's two ways, the first uses your array the other adds the box only to selected slides.:
Sub addTxtBox()
Dim oTextBox As Shape
Dim strText As String
Dim oSlide As Slide '* Slide Object
Dim sldCurrSlides As SlideRange
Set sldCurrSlides = ActivePresentation.Slides.Range(Array(1, 2, 3, 4))

strText = "Replace this text with your analysis comments........."

For Each oSlide In sldCurrSlides

'Add text box with text string.
Set oTextBox = oSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 25, 575, 1050, 70)

With oTextBox
.Line.Visible = msoTrue
.Line.ForeColor.RGB = RGB(255, 0, 0)
.Line.BackColor.RGB = RGB(255, 255, 255)
.TextFrame.TextRange.Text = strText
.TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
.TextFrame.TextRange.Font.Name = "Arial"
.TextFrame.TextRange.Font.Size = "16"
.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignLeft
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Fill.Transparency = 0#
.Line.Weight = 2#
End With
Next oSlide

End Sub

Sub addTxtBoxALT()
Dim oTextBox As Shape
Dim strText As String
Dim oSlide As Slide '* Slide Object
Dim sldCurrSlides As SlideRange
On Error Resume Next
'basic error trap
If ActiveWindow.Selection.Type = ppSelectionNone Then Exit Sub
Set sldCurrSlides = ActiveWindow.Selection.SlideRange

strText = "Replace this text with your analysis comments........."

For Each oSlide In sldCurrSlides

'Add text box with text string.
Set oTextBox = oSlide.Shapes.AddTextbox(msoTextOrientationHorizontal, 25, 575, 1050, 70)

With oTextBox
.Line.Visible = msoTrue
.Line.ForeColor.RGB = RGB(255, 0, 0)
.Line.BackColor.RGB = RGB(255, 255, 255)
.TextFrame.TextRange.Text = strText
.TextFrame.TextRange.Font.Color.RGB = RGB(0, 0, 0)
.TextFrame.TextRange.Font.Name = "Arial"
.TextFrame.TextRange.Font.Size = "16"
.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignLeft
.Fill.Visible = msoTrue
.Fill.Solid
.Fill.ForeColor.RGB = RGB(255, 255, 255)
.Fill.Transparency = 0#
.Line.Weight = 2#
End With
Next oSlide

End Sub

twaintwist
07-03-2012, 08:24 AM
John --- thanks for the quick response --- this is excellent ----

I was stuck on the 'ActiveWindow' ---- you cleared it up nicely ----

John Wilson
07-03-2012, 08:30 AM
Note that you should NOT select the textrange too.

It is hardly ever necessary to select and will often throw errors if the object is not selectable (eg if it is on a non active slide)