Question

标题几乎说。

我需要在目录（已完成）中递归打开所有PowerPoint文件。
我需要从已经打开的文件中复制Userform和模块。
我需要将原始目录中的所有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

Answer 1

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

此代码

打开strDir下的所有文件，即* c：\ temp *
从当前PPT文件导出模块 Module1 和userform 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

Answer 2

如果您获得对Presentation返回的Presentations.Open对象的引用，则可以直接操作打开的演示文稿。否则，打开它们后必须遍历Presentations对象。如果您有Presentation个对象，则可以看到用于该SlideMaster的{{1}}。至于复制VBA代码，您可以尝试类似http://www.cpearson.com/excel/vbe.aspx或http://www.mrexcel.com/articles/copy-vba-module.php

的内容

示例：

Presentation

vba PowerPoint 2010打开多个文件，复制模块和用户表单，另存为.pptm

2 个答案: