1

我正在尝试获取 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 语句。现在我什至没有一个固定的声明，因为我无法得到正确的声明。任何帮助表示赞赏。下面是最新的代码。

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
4

2 回答 2

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 As Object启用对 Powerpoint 对象库的引用，这将允许您将其完全标注为PowerPoint.Application.

您当前的代码解释Dim tb as 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。

启用对 PPT 对象库的引用

更新 3

DuplicateMethod似乎在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
...
于 2013-05-16T15:16:37.930 回答
0

我忘记了我已经从文本框切换到了 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
于 2013-05-17T20:14:17.917 回答