Question

Hello Stack Overflow VBA专家！我带着另一个问题来找你。我为任何明显的错误或noobie错误道歉，因为我仍在研究我的技能。我的问题如下。

我需要将一批pptm文件转换为pptx。我试图重新调整我发现的将xlsx文件转换为xls文件的VBA宏。宏在指定的文件夹中打开xlsx文件，将其保存为xls文件，关闭它，然后移动到下一个文件，直到所有当前相关文件都被转换（这非常方便）。原始的宏代码是：

Sub ProcessFiles()
Dim Filename, Pathname, saveFileName As String
Dim wb As Workbook
Dim initialDisplayAlerts As Boolean
Pathname = "<insert_path_here>"  ' Needs to have a trailing \
Filename = Dir(Pathname & "*.xlsx")
initialDisplayAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
Do While Filename <> ""
Set wb = Workbooks.Open(Filename:=Pathname & Filename, _
                        UpdateLinks:=False)
wb.CheckCompatibility = False
saveFileName = Replace(Filename, ".xlsx", ".xls")
wb.SaveAs Filename:=Pathname & saveFileName, _
          FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
          ReadOnlyRecommended:=False, CreateBackup:=False
wb.Close SaveChanges:=False
Filename = Dir()
Loop
Application.DisplayAlerts = initialDisplayAlerts
End Sub

我需要这个功能，但要将pptm文件更改为pptx。所以，我按照以下方式对其进行了修改：

Sub ProcessFiles()
Dim Filename, Pathname, saveFileName As String
Dim ppPres As Presentation
Dim initialDisplayAlerts As Boolean
Pathname = "\\TRIFS03\RoamingProfiles\user\Documents\projectfolder\testfolder\"  ' Needs to have a trailing \
Filename = Dir(Pathname & "*.pptm")
initialDisplayAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
Do While Filename <> ""
Set ppPres = Presentations.Open(Filename:=Pathname & Filename, _
                        UpdateLinks:=False)
ppPres.CheckCompatibility = False
saveFileName = Replace(Filename, ".pptm", ".pptx")
ppPres.SaveAs Filename:=Pathname & saveFileName, _
          FileFormat:=ppSaveAsOpenXMLPresentation, Password:="", WriteResPassword:="", _
          ReadOnlyRecommended:=False, CreateBackup:=False
ppPres.Close SaveChanges:=False
Filename = Dir()
Loop
Application.DisplayAlerts = initialDisplayAlerts
End Sub

当我尝试运行它时，我得到Compile Error Named Argument Not Found，VBA指向UpdateLinks:=作为罪魁祸首。

我做了一些研究，发现我应该删除这段代码并且宏应该可以工作。所以我尝试了这个，并留下了以下代码：

Sub ProcessFiles()
Dim Filename, Pathname, saveFileName As String
Dim ppPres As Presentation
Dim initialDisplayAlerts As Boolean
Pathname = "\\TRIFS03\RoamingProfiles\user\Documents\projectfolder\testfolder\"  ' Needs to have a trailing \
Filename = Dir(Pathname & "*.pptm")
initialDisplayAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
Do While Filename <> ""
Set ppPres = Presentations.Open(Filename:=Pathname & Filename)
ppPres.CheckCompatibility = False
saveFileName = Replace(Filename, ".pptm", ".pptx")
ppPres.SaveAs Filename:=Pathname & saveFileName, _
          FileFormat:=ppSaveAsOpenXMLPresentation, Password:="", WriteResPassword:="", _
          ReadOnlyRecommended:=False, CreateBackup:=False
ppPres.Close SaveChanges:=False
Filename = Dir()
Loop
Application.DisplayAlerts = initialDisplayAlerts
End Sub

可悲的是，我得到了另一个Compile Error，但这次是Method or Data Member not Found并指向.CheckCompatability =作为罪魁祸首。所以我试着删除那个。我相信你可以猜到接下来会发生什么。

另一个Compile Error Named Argument Not Found指向Password:=。这种模式一直持续到我决定寻找新的宏。我最终偶然发现了这个：

With ActivePresentation
.SaveCopyAs _
    FileName:=.Path & "\" & Left(.Name, InStrRev(.Name, ".")) & "pptx", _
    FileFormat:=ppSaveAsOpenXMLPresentation
End With

但是，此代码不会循环。因此，使用我非常基本的VBA技能，我尝试添加适当的循环代码，最后得到：

Sub ProcessFiles()
Dim Filename, FileFormat As String
Dim initialDisplayAlerts As Boolean
initialDisplayAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
Do While Filename <> ""
.SaveCopyAs _
    Filename:=.Path & "\" & Left(.Name, InStrRev(.Name, ".")) & "pptx", _
    FileFormat:=ppSaveAsOpenXMLPresentation
ppPres.Close SaveChanges:=False
Filename = Dir()
Loop
Application.DisplayAlerts = initialDisplayAlerts
End Sub

最后我得到了另一个 Compile Error，但Invalid or Unqualified Reference被. Path指向是罪魁祸首。然而根据code’s author（参见最高投票答案），如果我使用.Path，我不需要定义\，除非我可怕错了（我可能是）。

所以现在，我非常困难。我很感激你们可以提供的任何帮助。感谢您抽出宝贵时间阅读我的帖子并尝试帮助我：）

Answer 1

类似的东西：

Sub ProcessFiles()
    Dim Filename, FileFormat As String
    Dim initialDisplayAlerts As Boolean
    initialDisplayAlerts = Application.DisplayAlerts
    Application.DisplayAlerts = False
    With ActivePresentation
        Do While Filename <> ""

            .SaveCopyAs _
              Filename:=.Path & "\" & Left(.Name, InStrRev(.Name, ".")) & "pptx", _
                                FileFormat:=ppSaveAsOpenXMLPresentation

           Filename = Dir()
       Loop
   End With
   Application.DisplayAlerts = initialDisplayAlerts
End Sub

VBA宏：批量保存PPTM到PPTX

1 个答案: