Add text box to the bottom of every slide, the text of the text box to be populated from entries in a table

Dear Experts:

I would like to run a macro that performs the following actions:

The macro is to add a text box at the bottom of each and every slide based on entries on a table that is located on the very first slide.

The 2 column, 12 rows table on Slide 1 has the following entries which should be put into that text box.

Row 2, Column 2:   Text 1
Row 9, Column 2:   Text 2
Row 12, Column 2: Text 3

Hence the text box to be added to all the slides (measurments and position: 'msoTextOrientationHorizontal, 30, 560, 750, 40') should look like this on every slide:

Text 1, Text 2, Text 3

Help is much appreciated. Thank you very much in advance.

Regards, Andreas
Andreas HermleTeam leaderAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

NorieAnalyst Assistant Commented:
Perhaps.
Dim pre As Presentation
Dim shp As Shape
Dim strText As String
Dim I As Long

    Set pre = ActivePresentation

    With pre
        With .Slides(1).Shapes(1).Table
            strText = .Cell(2, 2).Shape.TextFrame.TextRange.Text & .Cell(9, 2).Shape.TextFrame.TextRange.Text & .Cell(12, 2).Shape.TextFrame.TextRange.Text
        End With
        For I = 2 To .Slides.Count
            pre.Slides(I).Shapes.AddTextbox(msoTextOrientationHorizontal, 30, 560, 750, 40).TextFrame.TextRange.Text = strText
        Next I
    End With

Open in new window

0
Andreas HermleTeam leaderAuthor Commented:
Oh Norie, that was quick. Thank you, will test it as soon as possible :-)
0
Rgonzo1971Commented:
You probably watnt comma to separate the 3 texts

Dim pre As Presentation
Dim shp As Shape
Dim strText As String
Dim I As Long

    Set pre = ActivePresentation

    With pre
        With .Slides(1).Shapes(1).Table
            strText = .Cell(2, 2).Shape.TextFrame.TextRange.Text & ", " & _
                .Cell(9, 2).Shape.TextFrame.TextRange.Text & ", " & _
                .Cell(12, 2).Shape.TextFrame.TextRange.Text
        End With
        For I = 2 To .Slides.Count
            pre.Slides(I).Shapes.AddTextbox(msoTextOrientationHorizontal, 30, 560, 750, 40).TextFrame.TextRange.Text = strText
        Next I
    End With

Open in new window

0
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Rgonzo1971Commented:
if the table is not the first shape
then try
Sub Macro()
Dim pre As Presentation
Dim shp As Shape
Dim strText As String
Dim I As Long

    Set pre = ActivePresentation

    With pre
        For Each shp In .Slides(1).Shapes
            If shp.Type = msoTable Then Set tbl = shp.Table
        Next
        With tbl
            strText = .Cell(2, 2).Shape.TextFrame.TextRange.Text & ", " & _
                .Cell(9, 2).Shape.TextFrame.TextRange.Text & ", " & _
                .Cell(12, 2).Shape.TextFrame.TextRange.Text
        End With
        For I = 2 To .Slides.Count
            pre.Slides(I).Shapes.AddTextbox(msoTextOrientationHorizontal, 30, 560, 750, 40).TextFrame.TextRange.Text = strText
        Next I
    End With

End Sub

Open in new window

0
Andreas HermleTeam leaderAuthor Commented:
Hi Norie, hi Rafael

I am afraid to tell you that your code throws an error message (runtime error 8000 4005) on line 9

So does Rafael's first trial at this job (line 10)

Rafael your second code however does the trick . Thank you very much for it.

There is one thing I would like to have incorporated as well. Renewed running of the macro should delete all these textboxes at the bottom (I guess they need to be named programmatically) and then re-inserted with the current metadata.

I guess this is feasible.

Thank you very much for your great help. Regards, Andreas
0
Rgonzo1971Commented:
then try
Sub Macro1()
Dim pre As Presentation
Dim shp As Shape
Dim strText As String
Dim I As Long

    Set pre = ActivePresentation

    With pre
        For Each shp In .Slides(1).Shapes
            If shp.Type = msoTable Then Set tbl = shp.Table
        Next
        With tbl
            strText = .Cell(2, 2).Shape.TextFrame.TextRange.Text & ", " & _
                .Cell(9, 2).Shape.TextFrame.TextRange.Text & ", " & _
                .Cell(12, 2).Shape.TextFrame.TextRange.Text
        End With
        For I = 2 To .Slides.Count
            For Each shp1 In pre.Slides(I).Shapes
                If shp1.AlternativeText = "TableText" Then shp1.Delete
            Next
            Set tb = pre.Slides(I).Shapes.AddTextbox(msoTextOrientationHorizontal, 30, 560, 750, 40)
            tb.TextFrame.TextRange.Text = strText
            tb.AlternativeText = "TableText"
        Next I
    End With

End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Andreas HermleTeam leaderAuthor Commented:
Great job, Rafael, as always, very nice coding. Works like a charm.

Regards, Andreas
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.