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

<罢工> 这个管用 几乎完美。据我所知，所有的幻灯片和母版都被正确地检查了，但演讲者注释在西班牙语中仍然被错误地检查。我只在网上找到了访问“注释页”的解决方案，我已经这样做了。我认为演讲者注释与注释页不同。

仔细观察后，发现脚本并没有改变任何拼写检查语言。脚本运行时没有错误，并表明它找到了所有的文本框，所以现在我更迷茫了。

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

Answer 1

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

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文件，只需将此脚本放在script_name中即可。目录中的vbs文件与您的powerpoint文件，并使用CMD运行它

cscript.exe .\script_name.vbs

Answer 2

根据我对PowerPoint对象模型的研究，只有一个NotesPage属性，我认为它包括演讲者的笔记。虽然我已经很久没有主动使用PowerPoint了，但我记得每张幻灯片上都只有一个笔记页，我用它来存储演讲者的笔记。

既然如此，在我看来，你的剧本已经完成了。你确定它缺少一些部分吗？