Как да приложите този VBA към множество PPT файлове в папка

Бих искал този конкретен код да се изпълнява на множество файлове на powerpoint в папка. Но би било още по-добре, ако отвори файла на powerpoint, изпълни този код по-долу, запише го и след това отвори следващия. Всякакви предложения са добре дошли! Прегледах кода на този уебсайт, но изглежда не мога да го адаптирам към моя код по-долу (напр. този Преминаване през файлове в папка чрез VBA?)

ОПИТ ЗА ЛОУП

знаме

Sub LoopThroughFiles() 
Dim MyObj As Object, MySource As Object, file As Variant 
file = Dir("c:\testfolder\") 
While (file <> "") 
   If InStr(file, "test") > 0 Then 
          MsgBox "found " & file 
          Exit Sub 
    End If 
file = Dir 
Wend 
End Sub

Съществуващ код

Option Explicit

' Selects the shape that support text which is closest to the top of the slide
' Written by Jamie Garroch of YOUpresent Ltd (http://youpresent.co.uk)
Sub SelectHigestTextShape()
  Dim oSld As Slide
  Dim oShp As Shape, oShpTop As Shape
  Dim sShpTop As Single

  On Error Resume Next
  Set oSld = ActiveWindow.View.Slide
  If Err Then Exit Sub
  On Error GoTo 0

  ' Set the top to the bottom of the slide
  sShpTop = ActivePresentation.PageSetup.SlideHeight

  ' Check each shape on the slide is positioned above the stored position
  ' Shapes not supporting text and placeholders are ignored
  For Each oShp In oSld.Shapes
    If oShp.Top < sShpTop And oShp.HasTextFrame And Not oShp.Type = msoPlaceholder Then
      sShpTop = oShp.Top
      Set oShpTop = oShp
    End If
  Next

  ' Select the topmost shape
  If Not oShpTop Is Nothing Then oShpTop.Select msoTrue
    ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
  ' Clean up
  Set oSld = Nothing
  Set oShp = Nothing
  Set oShpTop = Nothing
End Sub

vba powerpoint
person Probs    schedule 22.09.2016    source източник
comment
Какво зацикляне опитахте?   -  person Nathan_Sav    schedule 22.09.2016
comment
Sub LoopThroughFiles() Dim MyObj As Object, MySource As Object, file As Variant file = Dir(c:\testfolder\) While (file ‹› ) If InStr(file, test) › 0 Then MsgBox found & file Exit Sub End If file = Dir Wend End Sub Добавих това към кода, но го изтрих, защото не работи :(   -  person Probs    schedule 22.09.2016
comment
Изглежда, че използва обекта на файловата система, заредили ли сте справката за това? Също така не изглежда правилно, там няма GetFolder като публикацията, от която копирате   -  person Nathan_Sav    schedule 22.09.2016
comment
Е, всъщност безнадеждно исках да пусна този макрос на всички отворени powerpoints..около 200, но дори това не проработи. Наистина съм нов в VBA, обикновено правя всичко в Python   -  person Probs    schedule 22.09.2016
comment
С цикъла, който предоставихте, вие превъртяхте през файловете, но не направихте нищо с тях.. Зададохте ли указател към PP файла някъде? Извикахте ли цикъла във вашия SelectHighestTextShape?   -  person Han Soalone    schedule 22.09.2016
comment
msdn.microsoft.com/en-us/library/office/ff746171. aspx и 4guysfromrolla.com/webtech/faq/FileSystemObject/faq5. shtml трябва да ви предостави помощта, от която се нуждаете. Това, което ще трябва да направите, е да отворите презентацията, след това да извикате функцията, след това да затворите pres, да отворите nect. Или можете да отворите към обект, да речем, set objPP=...open pres.. след това да предадете objPP във функцията като аргумент или да използвате публична променлива, така че можете да кажете sShpTop = objPP......   -  person Nathan_Sav    schedule 22.09.2016
comment
Но има множество PP файлове, аз го насочих към папка, където всички файлове са в & Sep & .ppt*, където декларирах Sep = '\'..Просто не знам как да комбинирам множество подзаписи, така че цикли и наистина ми трябва днес.   -  person Probs    schedule 22.09.2016
comment
Благодаря Nathan_Sav, ще опитам ;)   -  person Probs    schedule 22.09.2016

Отговори (1)


arrow_upward
0
arrow_downward

Това е моят примерен код за SelectHigestTextShape sub, но не съм сигурен, че ще работи както искате за множество файлове. Причината е, че е проектиран да ИЗБЕРЕ обект на текстово поле в рамките на АКТИВНАТА ПРЕЗЕНТАЦИЯ, използвайки АКТИВЕН ИЗГЛЕД. Нищо от това не съществува, когато преглеждате файлове в папка, тъй като ще трябва да отворите всеки от тях на свой ред, но дори и тогава какъв би бил смисълът да изберете форма само за затваряне на презентацията след това? Предполагам, че наистина трябва да знаем крайната цел. При типа групова обработка, който опитвате, не би било добра идея да избирате каквото и да било, тъй като това изисква изгледът на обекта да е активен, което е кошмар за отстраняване на грешки и забавя всичко много. Ако искате да направите нещо с определен обект, много по-добре е да използвате препратка към него, без да изисквате активен изглед или дори активен прозорец (можете да отворите всеки файл невидимо, да го обработите и след това да го затворите).

Този пример ще премине през папка, ще отвори всяка намерена презентация (без прозорец), ще премине през всички форми на всички слайдове, ще изведе броя на слайдовете и формите в непосредствения панел и след това ще затвори файла:

' Loop through all PowerPoint files in a specified folder
' Open each and then loop through each shape of each slide
' Output a count of slides and shapes in immediate pane before closing the file
' Modified by Jamie Garroch of YOUpresent Ltd (http://youpresent.co.uk)
Sub LoopThroughPPTFiles()
  Dim oPres As Presentation, oSld As Slide, oShp As Shape
  Dim SldCount As Long, ShpCount As Long
  Dim MyFile As String
  Const MyFolder = "c:\testfolder\"
  On Error GoTo errorhandler
  MyFile = Dir(MyFolder)
  While (MyFile <> "")
    If Right(MyFile, 5) Like ".ppt*" Then
      Set oPres = Presentations.Open(FileName:=MyFolder & MyFile, ReadOnly:=msoTrue, Untitled:=msoFalse, WithWindow:=msoFalse)
      For Each oSld In oPres.Slides
        SldCount = SldCount + 1
        For Each oShp In oSld.Shapes
          ShpCount = ShpCount + 1
        Next
      Next
      Debug.Print oPres.Name & " has " & SldCount & " slide(s) and " & ShpCount & " shapes."
      SldCount = 0: ShpCount = 0
      oPres.Close
    End If
    MyFile = Dir
  Wend
  ' clean up
  Set oPres = Nothing: Set oSld = Nothing: Set oShp = Nothing
  Exit Sub
errorhandler:
  If Not oPres Is Nothing Then oPres.Close: Set oPres = Nothing
End Sub

Можете да използвате това, за да разгледате след това формите след реда „За всеки oShp в oSld.Shapes“, за да намерите най-високо разположената на слайда и след това да я обработите (без да я избирате).

person Jamie Garroch - MVP    schedule 22.09.2016
comment
Е, вашият код ще работи, ако всеки PPT бъде отворен, формата ще бъде избрана (която е на първия PPT слайд навсякъде), ще бъде центрирана в средата, PPT ще бъде запазена и след това затворена и след това следващата ще бъде отворен и т.н. Между другото, страхотен код! - person Probs; 22.09.2016