對於Powerpoint（VBA）所有幻燈片中的每個文本框

Question

提前為我的英語不好道歉，我用了一部分谷歌翻譯...

我堅持循環使用Ppt幻燈片中分散的所有文本框。 我應該做的程序是首先從Word打開一個Ppt文件或搜索在用作標簽的文本框中輸入的代碼。 一旦找到相應的代碼（我不知道我寫的對不對），應復制整個幻燈片（我不知道如何告訴它采用文本框的代碼）並將其粘貼到頁面上（用於現在隨機）在Word中。 我在Google上進行了搜索，發現一個看似不錯的代碼，但在第二個“ For Each”中為“ ERROR 13”

 public sub elaboraSlidePpt ()


    Dim pptPres As PowerPoint.Presentation
    Dim pptApp As PowerPoint.Application
    Dim pptSlide As PowerPoint.Slide
    Dim pptPath As String
    Set doc = Application.ActiveDocument
    Dim docPpt As Slide

    pptPath = file_dir + "\" + file_name

    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = False
    Set pptPres = pptApp.Presentations.Open(pptPath)

    Dim sld As Slide, shp As Shape
    For Each sld In pptApp.ActivePresentation.Slides
      For Each shp In sld.Shapes '<-- ERROR 13
        If shp.Type = "img10" Then

            pptApp.ActivePresentation.Slides(????).Copy
            Application.ActiveDocument.Activate
            Selection.PasteAndFormat (wdPasteEnhancedMetafile)

        End If
      Next shp
    Next sld
 end sub

Answer 1

我已經糾正了許多問題。 試試看：

public sub elaboraSlidePpt ()

    Dim pptPres As PowerPoint.Presentation
    Dim pptApp As PowerPoint.Application
    Dim pptSlide As PowerPoint.Slide
    ' Create a POWERPOINT slide variable to use later
    Dim pptShape as PowerPoint.Shape
    Dim pptPath As String
    Set doc = Application.ActiveDocument
    Dim docPpt As Slide

    ' use & to combine strings, not +
    pptPath = file_dir & "\" & file_name

    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = False
    Set pptPres = pptApp.Presentations.Open(pptPath)

    'Dim sld As Slide, shp As Shape
    For Each pptSlide In pptPres.Slides
      For Each pptShape In pptSlide.Shapes
        ' You'll need to fix this ... 
        ' .Type will return a Long, not a string
        If pptShape.Type = "img10" Then

            pptSlide.Copy
            Application.ActiveDocument.Activate
            Selection.PasteAndFormat (wdPasteEnhancedMetafile)

        End If
      Next ' Shape
    Next ' Slide
 end sub