Perform macro for all open presentations

Question

I've the following code which I use to place a shape on the first slide of one my powerpoints.

Sub WriteToTextBox()
Dim tb As Shape
Dim sld As Slide
Dim pres As Presentation
Dim var1 As String


var1 = InputBox("Var1")
Set pres = ActivePresentation
Set sld = pres.Slides(1) 'Modify as needed

Set tb = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 400, 400, 100, 50) 
tb.Name = "InsertShape"  
tb.TextFrame.TextRange.Text = var1

End Sub

I know want to perform this for all my open presentations. I tried to do this like this

Sub WriteToTextBoxALL()

Dim i as integer
Dim pptcount as integer

Dim tb As Shape
Dim sld As Slide
Dim pres As Presentation
Dim var1 As String

For i = 1 to pptcount

var1 = InputBox("Var1")
Set pres = ActivePresentation
Set sld = pres.Slides(1) 'Modify as needed

Set tb = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 400, 400, 100, 50) 
tb.Name = "InsertShape"  
tb.TextFrame.TextRange.Text = var1

Next
End Sub

But I get an error. Anybody input on what im doing wrong?

Dear regards,

Marc

Answer 1

You need to set pptcount. I changed your code to this:

Sub WriteToTextBoxALL()

    Dim i As Integer
    Dim pptcount As Integer

    Dim tb As Shape
    Dim sld As Slide
    Dim pres As Presentation
    Dim var1 As String

    pptcount = Application.Presentations.Count

    For i = 1 To pptcount
        Set pres = Application.Presentations(i)

        var1 = InputBox("Var1")
        Set sld = pres.Slides(1)

        Set tb = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 400, 400, 100, 50)
        tb.Name = "InsertShape"
        tb.TextFrame.TextRange.Text = var1

    Next
End Sub

Edit:

For just drawing a normal border to your shape, add

tb.Line.Visible = True  

---

Explanation to with-statements