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

461 views Asked by At

I have over 700 slides split amongst about 30 pptx files. Many of the files have parts of their text set to spell check in Spanish. To change the spellcheck language for every text in every slide, I've been scouring the internet for VBS scripts that will do just that. Unfortunately, there hasn't been a complete solution for me: various errors occurred, not every script included masters and notes pages, etc. So I wrote my own in an effort to solve my own problem. Here it is:

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

This works almost perfectly. As far as I can tell, all the slides and masters are correctly checked, but the speaker notes are still incorrectly checked in Spanish. I've only found solutions online that access the "Notes Page" which I already do. I think the speaker notes are different than the notes page.

After looking more closely, it turns out the script doesn't change any of the spellcheck languages. The script runs without error and indicates that it finds all the text boxes, so now I'm even more lost.

How do I use VBS to change the language of the speaker notes (not the notes page) for these presentations?

2

There are 2 answers

0
AudioBubble On BEST ANSWER

Finally after much headache and a bit of shameful embarrassment, I realized the problem. I never saved my changes. Also, the previous script ungrouped anything that was previously grouped, but I fixed that as well. The following code successfully sets ALL the spell-check languages to US English:

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

I sincerely hope this can help save some people from the intense frustration I have experienced over the past few days. If you've got powerpoint files with messed up languages, just put this script in a script_name.vbs file in the directory with your powerpoint files and run it with the CMD

cscript.exe .\script_name.vbs
0
David A. Gray On

From what I can tell by studying the PowerPoint object model, there is only a NotesPage property, which, I presume, includes the speaker's notes. Though it's been quite a while since I actively used PowerPoint, I recall only a single NotesPage being attached to each slide, and that I used it to store my speaker's notes.

That being the case, it looks to me like your script is complete. Are you sure that it is missing some parts?