夜间模式暗黑模式
字体
阴影
滤镜
圆角
主题色
批量转换.ppt格式至.pptx格式

一直以来在iOS上使用Microsoft Powerpoint打开.ppt文件时需要在线转换,以前不知道为什么,以为打开任意文件都需要联网。但偶然发现.pptx文件可以直接打开,不需要联网。(以前还觉得微软不厚道,现在看来应该是考虑到容量等问题舍弃了兼容性)

这带来一个问题,我上课所用的课件是.ppt格式的,自然我想全部转为.pptx,iPad上打开就不需要联网了。在线搜索了一翻,发现这里提供了一个方法。赶紧尝试了一下,确实可以批量转换,但转换完还是.ppt,且文件变得更大了!打开一看,果然还是兼容模式打开的,并非.pptx格式。于是仔细看了下代码,问题出在

Call oPresentation.SaveAs(sFolder & "N_" & sPresentationName, ppSaveAsPresentation)

这一行,最后的参数ppSaveAsPresentation指定保存文件格式仍为.ppt格式,于是上微软网站搜索VBA帮助,将这个参数改为ppSaveAsOpenXMLPresentation,再次运行,发现文件应该保存为pptx格式了,但扩展名仍为ppt,于是再次修改保存文件时文件名相关代码,搞定。:smile:

贴上完整代码以留档。

Sub BatchSave()
' Opens each PPT in the target folder and saves as PPTX format

    Dim sFolder As String
    Dim sPresentationName As String
    Dim oPresentation As Presentation

    ' Get the foldername:

    sFolder = InputBox("Folder containing PPT files to process", "Folder")

    If sFolder = "" Then
        Exit Sub
    End If

    ' Make sure the folder name has a trailing backslash
    If Right$(sFolder, 1) <> "\" Then
        sFolder = sFolder & "\"
    End If

    ' Are there PPT files there?
    If Len(Dir$(sFolder & "*.PPT")) = 0 Then
        MsgBox "Bad folder name or no PPT files in folder."
        Exit Sub
    End If

    ' Open and save the presentations
    sPresentationName = Dir$(sFolder & "*.ppt")
    While sPresentationName <> ""
        Set oPresentation = Presentations.Open(sFolder & sPresentationName, , , False)
        Call oPresentation.SaveAs(sFolder & "N_" & sPresentationName & "x", ppSaveAsOpenXMLPresentation)
        oPresentation.Close
        ' New presentation is now saved as N_originalname.pptx
        ' Now let's rename them - comment out the next couple lines
        '   if you don't want to do this
        ' Original.PPT to Original.PPT.OLD
        Name sFolder & sPresentationName As sFolder & sPresentationName & ".OLD"
        ' N_Original.pptx to Original.pptx
        Name sFolder & "N_" & sPresentationName & "x" As sFolder & sPresentationName & "x"
        sPresentationName = Dir$()
    Wend

    MsgBox "DONE"

End Sub
暂无评论

发送评论 编辑评论


				
下一篇