如何使用 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