对于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