编写Excel VBA代码/宏以使用Excel单元格值填充Powerpoint文本框

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

所以我写这个VBA代码是为了尝试填充文本框。我做过很多VBA，但从未尝试过这种组合。下面是我到目前为止所做的（更多的代码将放在额外的文本框中，但需要先让一个工作）。我意识到问题与未正确处理对象有关，但不确定如何纠正它

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

谢谢

 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

虽然幻灯片的复制工作正常，但我仍然无法对文本框进行估价。我无法在语句之前找到正确的set语句，以便将值分配给textbox。现在我甚至没有一个set语句，因为我没有得到正确的语句。感谢您的帮助。下面是最新的代码

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错误

要在形状中插入文本，需要识别形状，然后操纵其

.text

。我发现使用形状变量最容易做到这一点

'## 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

我认为您得到了不匹配错误，因为您将

PPT作为对象

，而不是启用对Powerpoint对象库的引用，从而允许您将其作为

Powerpoint.Application

进行完全尺寸标注

您当前的代码将

Dim tb解释为Shape

引用的是Excel.Shape，而不是Powerpoint.Shape

如果启用对Powerpoint对象库的引用，则可以执行以下操作：

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

如果您不想或无法启用对PPT对象库的引用，请尝试

Dim tb as Variant

或

Dim tb as object

，这可能会起作用

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

在VBE中的“工具参考”中，选中与您的计算机支持的PPT版本对应的框。在Excel 2010中，这是14.0。2007年我认为是12.0

更新3

replicate

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

请尝试以下方法：

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

---

txtReqBase

无效。它在代码中没有声明为变量，在Powerpoint中它肯定不是受支持的属性/方法，这就是为什么会出现438错误

要在形状中插入文本，需要识别形状，然后操纵其

.text

。我发现使用形状变量最容易做到这一点

'## 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

我认为您得到了不匹配错误，因为您将

PPT作为对象

，而不是启用对Powerpoint对象库的引用，从而允许您将其作为

Powerpoint.Application

进行完全尺寸标注

您当前的代码将

Dim tb解释为Shape

引用的是Excel.Shape，而不是Powerpoint.Shape

如果启用对Powerpoint对象库的引用，则可以执行以下操作：

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

如果您不想或无法启用对PPT对象库的引用，请尝试

Dim tb as Variant

或

Dim tb as object

，这可能会起作用

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

在VBE中的“工具参考”中，选中与您的计算机支持的PPT版本对应的框。在Excel 2010中，这是14.0。2007年我认为是12.0

更新3

replicate

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

请尝试以下方法：

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

---

我忘了我已经从文本框切换到activex控件文本框。这是正确的代码

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

---

我忘了我已经从文本框切换到activex控件文本框。这是正确的代码

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

---

什么是

txtReqBase

？？它没有在代码中的任何地方声明，并且在PPT中似乎不是有效的对象/属性/方法。

txtReqCurr

也可能发生同样的错误。什么是

txtReqBase

？？它没有在代码中的任何地方声明，并且在PPT中似乎不是有效的对象/属性/方法。同样的错误可能会发生在

txtReqCurr

上。谢谢David。在我发布这篇文章之后，我实际上已经将txtReqBase改回了TexBox1。我最初是想给它一个唯一的标识符。我尝试了您的代码，但set语句实际上产生了类型不匹配。另外，为什么将tb设置为形状而不是对象？文本框是幻灯片形状集合的成员。将其具体标注为形状而不是通用对象/变量可以启用VBE中的脚本辅助功能。我以前曾尝试将引用定义为PowerPoint…，但此版本的Excel（2007）无法将其识别为有效类型。您必须在VBE窗口的“工具|引用”下启用对Powerpoint的引用，然后选中“Microsoft Powerpoint 12.0对象库”框。谢谢David。在我发布这篇文章之后，我实际上已经将txtReqBase改回了TexBox1。我最初是想给它一个唯一的标识符。我试过你的代码，但设置状态是