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

时间：2015-06-11 04:25:58

标签： vbscript powerpoint spell-checking

我有超过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页面”的解决方案。我认为演讲者的笔记与笔记页不同。

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

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

2 个答案:

答案 0 :(得分：0)

通过研究PowerPoint对象模型我可以看出，只有一个NotesPage属性，我认为，它包括说话者的笔记。虽然我积极使用PowerPoint已经有一段时间了，但我记得每张幻灯片只附加一个NotesPage，我用它来存储我的演讲者的笔记。

在这种情况下，它看起来像你的脚本是完整的。你确定它缺少某些部分吗？

答案 1 :(得分：0)

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

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
相关问题
最新问题