編寫Excel VBA代碼/宏以使用Excel單元格值填充Powerpoint文本框

Question

我正在嘗試在Excel單元格中獲取值並填充PowerPoint文本框。 我不想將PowerPoint表鏈接到Excel電子表格，因為電子表格在不斷變化並且值並不總是在相同的行或相同的順序中。

因此，我正在編寫此VBA代碼以嘗試填充文本框。 我做了很多VBA，但從未嘗試過這種組合。 到目前為止，這是我所擁有的（更多的代碼將用於其他文本框，但需要首先使用它）。 我意識到問題與未正確處理對象有關，但不確定如何更正。

我正在使用Excel和PowerPoint2007。粗體語句是我收到錯誤的地方-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

Answer 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解釋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。

更新3

“ Duplicate方法”似乎在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
...

Answer 2

我忘記了我已經從文本框切換到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