编写Excel VBA代码/宏以使用Excel单元格值填充Powerpoint文本框 [英] Writing Excel VBA code/macro to populate Powerpoint Text boxes with Excel cell values

问题描述

我试图在Excel单元格中填充值并填充PowerPoint文本框。我不想将PowerPoint表格链接到Excel电子表格，因为电子表格不断变化，值并不总是在同一行或相同的顺序。

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.

所以我正在编写这个VBA代码来尝试填充文本框。我做了很多VBA，但从未尝试过这样的组合。以下是我到目前为止（更多的代码将被放入附加的文本框，但需要先工作一个）。我意识到问题与对象没有正确处理有关，但不知道如何纠正它。

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.

我正在使用Excel和PowerPoint 2007.粗体语句是我收到错误的地方 - 438对象不支持此属性或方法。

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.

谢谢！

 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

更新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

推荐答案

txtReqBase 无效。它不会在你的代码中被声明为一个变量，它在Powerpoint当然不是一个支持的属性/方法，这就是为什么你得到438错误。

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.

要插入在形状的文本中，您需要识别形状，然后操作其 .Text 。我觉得最简单的方法是使用一个形状变量。

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

更新对于不匹配错误设置 tb 。

UPDATE For Mismatch error setting tb.

我以为你得到不匹配的错误，因为你有 PPT As Object 比启用对Powerpoint对象库的引用，这将允许您将其完全定义为 PowerPoint.Application 。

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.

您当前的代码解释 Dim tb as Shape 指的是Excel.Shape，而不是Powerpoint.Shape。

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

如果启用引用Powerpoint对象库，那么你可以执行

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

如果你不想，或者可以不要启用对PPT对象库的引用，尝试以 Dim tb as Variant 或 Dim tb as Object 工作。

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.

更新2 如何启用对Powerpoint的引用：

UPDATE 2 How to enable reference to Powerpoint:

在VBE，来自Tools |参考，选中对应于您的机器上支持的PPT版本的框。在Excel 2010中，这是14.0。 2007年我认为是12.0。

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.

更新3

复制方法在2007年似乎不可用。无论如何，在2010年，它也会导致一个奇怪的错误，虽然幻灯片被正确复制，但是该变量未设置。

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.

尝试改为：

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
...

这篇关于编写Excel VBA代码/宏以使用Excel单元格值填充Powerpoint文本框的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！