如何使用 VBS 更改 Powerpoint 中 SPEAKER NOTES 的拼写检查语言？

Question

我有 700 多张幻灯片，分为大约 30 个 pptx 文件。许多文件的部分文本设置为西班牙语拼写检查。要更改每张幻灯片中每个文本的拼写检查语言，我一直在互联网上搜索可以执行此操作的 VBS 脚本。不幸的是，我还没有一个完整的解决方案：出现了各种错误，并不是每个脚本都包含母版和注释页等。所以我自己写了一个来解决我自己的问题。这是：

Option Explicit

Const msoFalse = 0
Const msoTrue = -1
Const msoLanguageIDEnglishUS = 1033
Const msoGroup = 6  

Dim intShapeCount, intTextCount 

Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objStartingFolder : Set objStartingFolder = objFSO.GetFolder(".\")  

IterateContainingItems objStartingFolder    

Sub IterateContainingItems(objCurrentFolder)
    Dim colFiles : Set colFiles = objCurrentFolder.Files
    Dim objCurrentFile
    For Each objCurrentFile in colFiles
        ReportInfo(objCurrentFile)
    Next
    Dim colFolders : Set colFolders = objCurrentFolder.SubFolders
    Dim objNextFolder
    For Each objNextFolder in colFolders
        IterateContainingItems objNextFolder
    Next
End Sub 

Sub ReportInfo(objCurrentFile)
    Dim strPathToFile
    strPathToFile = objFSO.GetAbsolutePathName(objCurrentFile.Path)
    Wscript.Echo strPathToFile
    If objFSO.GetExtensionName(strPathToFile) = "pptx" Then
        Dim objPowerpointApp, objPresentations, objPresentation, objSlides, intSlideCount
        set objPowerpointApp = CreateObject("Powerpoint.Application")
        set objPresentations = objPowerpointApp.Presentations
        Set objPresentation = objPresentations.Open(strPathToFile, 0, 0, 0)
        Set objSlides = objPresentation.Slides
        intSlideCount = objSlides.Count

        ResetLanguage objPresentation
        Wscript.Echo vbTab & "Slides:   " & intSlideCount
        Wscript.Echo vbTab & "Shapes:   " & intShapeCount
        Wscript.Echo vbTab & "Text: " & intTextCount

        objPresentation.Close
        objPowerpointApp.Quit
    Else
        Wscript.Echo vbTab & "N/A"
    End If
End Sub 


Sub ResetLanguage(objCurrentPresentation)
    'change shapes from presentation-wide masters
    Dim objShape
    intShapeCount = 0
    intTextCount = 0
    If objCurrentPresentation.HasHandoutMaster Then
        For Each objShape in objCurrentPresentation.HandoutMaster.Shapes
            ChangeLanguage objShape
        Next
    End If
    If objCurrentPresentation.HasNotesMaster Then
        For Each objShape in objCurrentPresentation.NotesMaster.Shapes
            ChangeLanguage objShape
        Next
    End If
    If objCurrentPresentation.HasTitleMaster = msoTrue Then
        For Each objShape in objCurrentPresentation.TitleMaster.Shapes
            ChangeLanguage objShape
        Next
    End If
    'change shapes from each design's master
    Dim tempDesign
    For Each tempDesign in objCurrentPresentation.Designs
        For Each objShape in tempDesign.SlideMaster.Shapes
            ChangeLanguage objShape
        Next
    Next
    'change shapes from each slide
    Dim tempSlide
    For Each tempSlide in objCurrentPresentation.Slides
        For Each objShape in tempSlide.Shapes
            ChangeLanguage objShape
        Next
        If tempSlide.hasNotesPage Then
            For Each objShape in tempSlide.NotesPage.Shapes
                ChangeLanguage objShape
            Next
        End If
    Next
End Sub 

Sub ChangeLanguage(objShape)
    If objShape.Type = msoGroup Then
        Dim objShapeGroup : Set objShapeGroup = objShape.Ungroup
        Dim objShapeChild
        For Each objShapeChild in objShapeGroup
            ChangeLanguage objShapeChild
        Next
    Else
        intShapeCount = intShapeCount + 1
        If objShape.HasTextFrame Then
            intTextCount = intTextCount + 1
            If objShape.TextFrame.TextRange.Length = 0 Then
                objShape.TextFrame.TextRange.Text = "[PLACEHOLDER_TEXT_TO_DELETE]"
            End If
            objShape.TextFrame.TextRange.LanguageID = msoLanguageIDEnglishUS
            If objShape.TextFrame.TextRange.Text = "[PLACEHOLDER_TEXT_TO_DELETE]" Then
                objShape.TextFrame.TextRange.Text = ""
            End If
        End If
    End If
End Sub

这几乎完美。据我所知，所有幻灯片和母版均已正确检查，但西班牙语的演讲者备注仍未正确检查。我只在网上找到了可以访问 "Notes Page" 的解决方案，我已经这样做了。我认为演讲者备注与备注页面不同。

仔细查看后发现，脚本并未更改任何拼写检查语言。脚本运行没有错误，并指示它找到了所有文本框，所以现在我更迷路了。

如何使用 VBS 更改这些演示文稿的演讲者备注（不是备注页面）的语言？

Answer 1

据我研究 PowerPoint 对象模型得知，只有一个 NotesPage 属性，我推测其中包含演讲者的注释。虽然自从我积极使用 PowerPoint 以来已经有一段时间了，但我记得每张幻灯片只附加了一个 NotesPage，我用它来存储演讲者的笔记。

既然如此，在我看来你的脚本已经完成了。您确定它缺少某些零件吗？

Answer 2

在经历了很多头痛和一些可耻的尴尬之后，我终于意识到了问题所在。 我从未保存我的更改。另外，之前的脚本取消了之前分组的所有内容，但我也修复了它。以下代码成功地将所有拼写检查语言设置为美国英语：

Option Explicit

'microsoft office constants
Const msoTrue = -1
Const msoFalse = 0
Const msoLanguageIDEnglishUS = 1033
Const msoGroup = 6

'starting folder (current folder)
Const START_FOLDER = ".\"
'valid powerpoint file extensions
Dim FILE_EXTENSIONS : FILE_EXTENSIONS = Array("pptx", "pptm", "ppt", "potx", "potm", "pot")
'desired language for all Text
Dim DESIRED_LANGUAGE : DESIRED_LANGUAGE = msoLanguageIDEnglishUS

'VBScript file system objects for starting folder
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objStartingFolder : Set objStartingFolder = objFSO.GetFolder(START_FOLDER)

IterateContainingItems objStartingFolder

'recursive subroutine to iterate each file in specified folder and all subfolders
Sub IterateContainingItems(objCurrentFolder)
    Dim colFiles : Set colFiles = objCurrentFolder.Files
    Dim objCurrentFile
    For Each objCurrentFile in colFiles
        ReportInfo(objCurrentFile)
    Next
    Dim colFolders : Set colFolders = objCurrentFolder.SubFolders
    Dim objNextFolder
    For Each objNextFolder in colFolders
        IterateContainingItems objNextFolder
    Next
End Sub

'subroutine executed for every file iterated by IterateContainingItems subroutine
'if it is a powerpoint file, echo the number of slides and the number of text-boxes changed
Sub ReportInfo(objCurrentFile)
    Dim strPathToFile
    strPathToFile = objFSO.GetAbsolutePathName(objCurrentFile.Path)
    Wscript.Echo strPathToFile

    If isPowerpointFile(strPathToFile) Then
        Dim objPowerpointApp, objPresentations, objPresentation, objSlides, intSlideCount

        set objPowerpointApp = CreateObject("Powerpoint.Application")
        set objPresentations = objPowerpointApp.Presentations
        Set objPresentation = objPresentations.Open(strPathToFile, msoFalse, msoFalse, msoFalse)
        Set objSlides = objPresentation.Slides
        intSlideCount = objSlides.Count 

        Wscript.Echo vbTab & "Slides:" & vbTab & intSlideCount

        ResetLanguage objPresentation

        objPresentation.Save
        objPresentation.Close
        objPowerpointApp.Quit
    Else
        Wscript.Echo vbTab & "N/A"
    End If
End Sub

'check if given filepath specifies a powerpoint file as described by the "constant" extension array
Function isPowerpointFile(strFilePath)
    Dim strExtension, found, i
    strExtension = objFSO.GetExtensionName(strFilePath)
    found = false
    for i = 0 to ubound(FILE_EXTENSIONS)
        if FILE_EXTENSIONS(i) = strExtension then    
            found = true
            exit for
        end if
    next
    isPowerpointFile = found
End Function

'finds every shape in the entire document and attempts to reset its LanguageID
Sub ResetLanguage(objCurrentPresentation)
    Dim objShape

    'change shapes from presentation-wide masters
    If objCurrentPresentation.HasHandoutMaster Then
        For Each objShape in objCurrentPresentation.HandoutMaster.Shapes
            ChangeLanguage objShape
        Next
    End If
    If objCurrentPresentation.HasNotesMaster Then
        For Each objShape in objCurrentPresentation.NotesMaster.Shapes
            ChangeLanguage objShape
        Next
    End If
    If objCurrentPresentation.HasTitleMaster = msoTrue Then
        For Each objShape in objCurrentPresentation.TitleMaster.Shapes
            ChangeLanguage objShape
        Next
    End If
    'change shapes from each design's master
    Dim tempDesign
    For Each tempDesign in objCurrentPresentation.Designs
        For Each objShape in tempDesign.SlideMaster.Shapes
            ChangeLanguage objShape
        Next
    Next
    'change shapes from each slide
    Dim tempSlide
    For Each tempSlide in objCurrentPresentation.Slides
        For Each objShape in tempSlide.Shapes
            ChangeLanguage objShape
        Next
        If tempSlide.hasNotesPage Then
            For Each objShape in tempSlide.NotesPage.Shapes
                ChangeLanguage objShape
            Next
        End If
    Next
End Sub

'if the given shape contains a text element, it checks and corrects the LanguageID
'if the given shape is a group, it iterates through each element in the group
Sub ChangeLanguage(objShape)
    If objShape.Type = msoGroup Then
        Dim objShapeGroup : Set objShapeGroup = objShape.GroupItems
        Dim objShapeChild
        For Each objShapeChild in objShapeGroup
            ChangeLanguage objShapeChild
        Next
    Else
        If objShape.HasTextFrame Then
            Dim intOrigLanguage : intOrigLanguage = objShape.TextFrame.TextRange.LanguageID
            If Not intOrigLanguage = DESIRED_LANGUAGE Then
                If objShape.TextFrame.TextRange.Length = 0 Then
                    objShape.TextFrame.TextRange.Text = "[PLACEHOLDER_TEXT_TO_DELETE]"
                End If
                objShape.TextFrame.TextRange.LanguageID = DESIRED_LANGUAGE
                If objShape.TextFrame.TextRange.Text = "[PLACEHOLDER_TEXT_TO_DELETE]" Then
                    objShape.TextFrame.TextRange.Text = ""
                End If
            End If
        End If
    End If
End Sub

我真诚地希望这可以帮助一些人从我过去几天所经历的强烈挫折中解脱出来。如果你有乱七八糟的语言的 powerpoint 文件，只需将这个脚本放在你的 powerpoint 文件目录中的 script_name.vbs 文件中，然后使用 CMD

运行它

cscript.exe .\script_name.vbs

如何使用 VBS 更改 Powerpoint 中 SPEAKER NOTES 的拼写检查语言？

How can I use VBS to change the spell check language of SPEAKER NOTES in Powerpoint?

vbscript

powerpoint

spell-checking