4

标题说得差不多了。

  1. 我需要在一个目录中递归地打开所有的 PowerPoint 文件（完成）。
  2. 我需要从已经打开的文件中复制用户表单和模块。
  3. 我需要将原始目录中的所有 PowerPoint 文件重新保存为启用宏的 PowerPoint 文档。

对于加分，我如何确保所有文件都具有与原始文件相同的母版幻灯片，并且当母版更改时幻灯片会更新。

这是打开文件的代码。有用。

Sub OpenAllFiles()

Dim colFiles As New Collection
Dim vFile As Variant
RecursiveDir colFiles, "C:\Users\Debra\Dropbox\School\Mathematics\Notes", "*.pptx", True
For Each vFile In colFiles    
        Presentations.Open (vFile)
Next vFile
End Sub
4

2 回答 2

3

您提出的问题（在奖金之前）

这段代码

  • 打开strDir ie *c:\temp*下的所有文件
  • 从当前 PPT 文件中导出一个模块Module1和一个用户窗体 UserForm
  • 将这些文件保存strDir为pptm文件
  • 删除原始pptx文件

代码

Sub OpenAllFiles()
Dim ppPres As Presentation
Dim fName As String
Dim strDir As String
Dim VbComp1
Dim VbComp2
Set VbComp1 = ActivePresentation.VBProject.VBComponents("Module1")
Set VbComp2 = ActivePresentation.VBProject.VBComponents("UserForm1")
strDir = "c:\temp\"
VbComp1.Export strDir & "\mod1.bas"
VbComp2.Export strDir & "\uf1.frm"

fName = Dir(strDir & "\*.pptx")
Do While fName <> vbNullString
Set ppPres = Presentations.Open(strDir & "\" & fName, msoFalse)
With ppPres
.VBProject.VBComponents.Import strDir & "\mod1.bas"
.VBProject.VBComponents.Import strDir & "\uf1.frm"
.SaveAs Replace(ppPres.Name, "pptx", "pptm"), ppSaveAsOpenXMLShowMacroEnabled
.Close
'remove original pptx file
Kill Dir(strDir & "\*.pptx")
fName = Dir
End With
Loop
End Sub
于 2012-08-28T09:15:39.973 回答
1

如果您获得对Presentation从您返回的对象的引用，则Presentations.Open可以直接操作打开的演示文稿。否则，您必须在打开 Presentations 对象后循环它们。当你有一个Presentation对象时，你可以看到SlideMasterused for that Presentation。至于复制 VBA 代码，您可以尝试类似http://www.cpearson.com/excel/vbe.aspx或http://www.mrexcel.com/articles/copy-vb ​​a-module.php

例子：

Option Explicit

Sub Test()
    'Declare variables
    Dim oPres As Presentation
    Dim oMaster As Master

    'Get presentation
    Set oPres = Presentations.Open("Gud vilken härlig powerpoint.pptx")

    'Get master
    Set oMaster = oPres.SlideMaster

    'Do something
    Debug.Print oPres.Name
    Debug.Print oMaster.Name

    'Save as macro-ppt
    Call oPres.SaveAs("NEW-FILE-NAME.pptm", ppSaveAsOpenXMLPresentationMacroEnabled)

    'Clean up
    Set oMaster = Nothing
    Set oPres = Nothing

End Sub
于 2012-08-28T07:48:35.550 回答