简体   繁体   中英

For each text box in all slides of power point (VBA)

Apologize in advance for my bad english, i used part google translate ...

I stuck in cycling all the text boxes scattered in the Ppt slides. What I should do my program is to initially open a Ppt file from Word or search for codes entered in the text boxes used as tags. Once I find the corresponding code (I do not know if I wrote it right) should make a copy of the entire slide (I do not know how to tell it to take that of the text box) and paste it on a page (for now at random) In Word. I searched on Google and found an apparently good code but I was "ERROR 13" in the second "For Each"

 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

I've corrected a number of things. Give this a try:

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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM