Writing Excel VBA code/macro to populate Powerpoint Text boxes with Excel cell values

问题

I am attempting to take the value in Excel cells and populate PowerPoint text boxes. I don't want to link a PowerPoint table to an Excel spreadsheet because the spreadsheet is constantly changing and values are not always in the same rows or the same order.

So I am writing this VBA code to try and populate the text boxes. I've done a lot of VBA, but never attempted this combination. Below is what I have thus far (more code will be put in for additional text boxes, but need to get one working first). I realize the issue has something to do with the object not being properly handled, but not sure how to correct it.

I'm using Excel and PowerPoint 2007. The bold statement is where I receive the error - 438 object does not support this property or method.

Thanks!

 Sub valppt()

 Dim PPT As PowerPoint.Application
    Dim newslide As PowerPoint.Slide
    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 = ActivePresentation.Slides(slideCtr).Duplicate
    Set tb = newslide.Shapes("TextBox1")

    slideCtr = slideCtr + 1
    ' Do Until ActiveCell.Value = ""
    Do Until slideCtr > 2
        If slideCtr = 2 Then
           tb.TextFrame2.TextRange.Characters.Text = ActiveCell.Value
        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

UPDATE 5/17

While the replication of the slide works, I am still unable to value the textbox. I haven't been able to come up with the right set statement prior to the statement to have the value assigned to the textbox. Right now I don't even have a set statement in there right now, because I haven't been able to get the proper one. Any assistance is appreciated. Below is the latest code.

Sub shptppt()
'
' shptppt Macro
'

    Dim PPT As PowerPoint.Application
    Dim pres As PowerPoint.Presentation
    Dim newslide As PowerPoint.Slide
    Dim slideCtr As Integer
    Dim tb As PowerPoint.Shape


    Set PPT = CreateObject("PowerPoint.Application")
    PPT.Visible = True

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

    Range("F2").Activate
    slideCtr = 1

    'Set newslide = ActivePresentation.Slides(slideCtr).Duplicate
    ' Set tb = newslide.Shapes("TextBox1")


    pres.Slides(slideCtr).Copy
    pres.Slides.Paste
    Set newslide = pres.Slides(pres.Slides.Count)
    newslide.MoveTo slideCtr + 1

    slideCtr = slideCtr + 1
    ' Do Until ActiveCell.Value = ""
    Do Until slideCtr > 2
        If slideCtr = 2 Then
            tb.Slides.TextFrame2.TextRange.Characters.Text = ActiveCell.Value
        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

回答1:

txtReqBase is not valid. it's not declared as a variable in your code, and it's certainly not a supported property/method in Powerpoint, and that's why you're getting the 438 error.

To insert text in a shape, you need to identify the shape and then manipulate its .Text. I find it easiest to do this with a shape variable.

'## If you have enabled reference to Powerpoint, then:'
Dim tb As Powerpoint.Shape
'## If you do not enable Powerpoint reference, use this instead'
'Dim tb as Variant '

Set tb = newSlide.Shapes("TextBox1")  '## Update this to use the correct name or index of the shapes collection ##'

tb.TextFrame2.TextRange.Characters.Text = ActiveCell.Value

UPDATE For Mismatch error setting tb.

I'm thinking you're getting the mismatch error because you have PPT As Object rather than enabling a reference to the Powerpoint Object Library which would allow you to fully dimension it as a PowerPoint.Application.

Your current code interprets Dim tb as Shape refers to an Excel.Shape, not a Powerpoint.Shape.

If you enable reference to the Powerpoint Object Library, then you can do

Dim PPT as Powerpoint.Application
Dim newSlide as Powerpoint.Slide
Dim tb as Powerpoint.Shape

If you don't want to, or can't enable reference to the PPT object library, try to Dim tb as Variant or Dim tb as Object and that might work.

UPDATE 2 How to enable reference to Powerpoint:

In the VBE, from Tools | References, check the box corresponding to the PPT version supported on your machine. In Excel 2010, this is 14.0. In 2007 I think it is 12.0.

Update 3

The Duplicate Method does not appear to be available in 2007. In any case, it also causes a strange error in 2010, although the slide is copied correctly, the variable is not set.

Try this instead:

Sub PPTTest()

Dim PPT As PowerPoint.Application
Dim pres As PowerPoint.Presentation
Dim newslide As PowerPoint.Slide
Dim slideCtr As Integer
Dim tb As PowerPoint.Shape

Set PPT = CreateObject("PowerPoint.Application")
PPT.Visible = True


'Control the presentation with a variable
Set pres = PPT.Presentations.Open("C:\users\david_zemens\desktop\Presentation1.pptx")

Range("F2").Activate
slideCtr = 1

'## This only works in 2010/2013 ##
'pres.Slides(slideCtr).Duplicate

'## Use this method in Powerpoint 2007 (hopefully it works)
pres.Slides(slideCtr).Copy
pres.Slides.Paste
Set newslide = pres.Slides(pres.Slides.Count)
newslide.MoveTo slideCtr + 1
...

回答2:

I had forgotten that I had switched from a textbox to an activex control textbox. here's the correct code now.

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 ActiveCell.Value = ""
'Do Until slideCtr > 2
    If slideCtr = 2 Then
       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

来源：https://stackoverflow.com/questions/16591029/writing-excel-vba-code-macro-to-populate-powerpoint-text-boxes-with-excel-cell-v

标签

excel

vba

excel-vba

textbox

powerpoint