CODEWITHSUNDEEP
excelvbatextboxpowerpoint
Spiderman
Spiderman

Reputation: 81

Unable to populate PowerPoint TextBox with value in Excel cell using VBA

It's all fixed now..I had forgotten I had used an activex control textbox not the "normal" PPT textbox. This is the correct basic code to populate a single textbox.

Thanks to David Zemens I got through some early issues I was having, but I still can't accomplish my end goal. He felt it was best to start a new thread so here it is.

The first thing I do is open the PPT file and duplicate the first slide. The duplicate method was replicating the slide, but was causing other issues, so Dave me a workaroundchange they way I copy the main slide. Below is the code I have written, which will not compile for the moment. (Also I've modified to just write to one textbox rather than use the looping which will eventually be done once I get one to work)

Any advice would be helpful. Please let me know if you need additional info and thanks!

valppt()

Dim PPT As PowerPoint.Application
Dim newslide As PowerPoint.SlideRange
Dim slideCtr As Integer
Dim tb As PowerPoint.Shape
Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True

PPT.Presentations.Open ("C:\Documents\createqchart.pptx")

Range("F2").Activate
slideCtr = 1

Set newslide = PPT.ActivePresentation.Slides(slideCtr).Duplicate
Set tb = newslide.Shapes("TextBox" & slideCtr)

slideCtr = slideCtr + 1

Do Until slideCtr > 2
    If slideCtr = 2 Then
       'tb.TextFrame.TextRange.Characters.Text = Format(ActiveCell.Value, "m/d/yyyy")
       tb.OLEFormat.Object.Value = Format(ActiveCell.Value, "m/d/yyyy")
    End If
    ActiveCell.Offset(0, 1).Activate
    slideCtr = slideCtr + 1

    If slideCtr = 38 Then
        Set newslide = PPT.ActivePresentation.Slides(slideCtr).Duplicate
        ActiveCell.Offset(1, -25).Activate
    End If

Loop

End Sub

Upvotes: 0

Views: 1956

Answers (1)

Spiderman
Spiderman

Reputation: 81

This is the correct code.

Sub valppt()
Dim PPT As PowerPoint.Application
Dim newslide As PowerPoint.SlideRange
Dim slideCtr As Integer
Dim tb As PowerPoint.Shape
Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True

PPT.Presentations.Open ("C:\Documents\createqchart.pptx")

Range("F2").Activate
slideCtr = 1

Set newslide = PPT.ActivePresentation.Slides(slideCtr).Duplicate
Set tb = newslide.Shapes("TextBox" & slideCtr)

slideCtr = slideCtr + 1

Do Until slideCtr > 2
    If slideCtr = 2 Then
       'tb.TextFrame.TextRange.Characters.Text = Format(ActiveCell.Value, "m/d/yyyy")
       tb.OLEFormat.Object.Value = Format(ActiveCell.Value, "m/d/yyyy")
    End If
    ActiveCell.Offset(0, 1).Activate
    slideCtr = slideCtr + 1

    If slideCtr = 38 Then
        Set newslide = PPT.ActivePresentation.Slides(slideCtr).Duplicate
        ActiveCell.Offset(1, -25).Activate
    End If

Loop
End Sub

Upvotes: 1

Related Questions