I have updated my previous VBA based solution to change a language in PowerPoint: now you can change the language of the whole presentation or of selected slides only. In some cases you may have some slides in a different language e.g. English instead of presentation language in German.
Use Case
In PowerPoint presentations the master presentation shall be for example in German but some slides are copied from another (international) presentation and shall rather be for example in English. For such cases, I like to be able to set a different language than the presentation's one for specific slides.
VBA Code
This feature is available in my PowerPoint Add-In (available in GitHub).
The dedicated module exported is available here SetLang.bas.
Code can be viewed in Gist embedded below.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Sub SetLang(langStr As String) | |
MSG1 = MsgBox("Do you want to change language of whole presentation vs. only selected slides?", vbYesNoCancel, "All or Only selected Slides?") | |
If MSG1 = vbYes Then | |
Call SetLangPres(ActivePresentation, langStr) | |
ElseIf MSG1 = vbNo Then | |
Call SetLangSelectedSlides(langStr) | |
End If | |
End Sub | |
Private Function SetLangPres(oPres As Presentation, lang As String) | |
' Reference http://stackoverflow.com/questions/4735765/powerpoint-2007-set-language-on-tables-charts-etc-that-contains-text | |
' http://stackoverflow.com/questions/37653183/vba-powerpoint-2013-change-presentation-language-including-smartart-objects | |
' https://support.microsoft.com/en-us/kb/245468 | |
Dim langID As Integer | |
langID = LangStr2Mso(lang) | |
On Error Resume Next | |
Dim oSlide As Slide | |
Dim oShape As Shape | |
'Set default language in application | |
oPres.DefaultLanguageID = langID | |
'Set language in each textbox in each slide | |
For Each oSlide In oPres.Slides | |
Call SetLangSlide(oSlide, langID) | |
Next | |
' Update Masters | |
For Each oShape In oPres.SlideMaster.Shapes | |
oShape.TextFrame.TextRange.LanguageID = langID | |
Next | |
For Each oShape In oPres.TitleMaster.Shapes | |
oShape.TextFrame.TextRange.LanguageID = langID | |
Next | |
For Each oShape In oPres.NotesMaster.Shapes | |
oShape.TextFrame.TextRange.LanguageID = langID | |
Next | |
' MsgBox | |
MsgBox "Presentation Language was changed to " & lang & ".", vbOKOnly, "SetLanguage" | |
End Function | |
' ------------------------------------------------------- | |
Sub SetLangSelectedSlides(langStr As String) | |
Dim langID As Integer | |
langID = LangStr2Mso(langStr) | |
Dim oSl As Slide | |
For Each oSl In ActiveWindow.Selection.SlideRange | |
Call SetLangSlide(oSl, langID) | |
Next oSl | |
MsgBox "Language of selected Slides (" & CStr(ActiveWindow.Selection.SlideRange.Count) & ") were changed to " & langStr & ".", vbOKOnly, "SetLanguage" | |
End Sub | |
Function SetLangSlide(oSlide As Slide, lang As Integer) | |
Dim oShape As Shape | |
Dim r, c As Integer | |
Dim oNode As SmartArtNode | |
On Error Resume Next | |
For Each oShape In oSlide.Shapes | |
'Check first if it is a table | |
If oShape.HasTable Then | |
For r = 1 To oShape.Table.Rows.Count | |
For c = 1 To oShape.Table.Columns.Count | |
oShape.Table.Cell(r, c).Shape.TextFrame.TextRange.LanguageID = lang | |
Next | |
Next | |
ElseIf oShape.HasSmartArt Then | |
For Each oNode In oShape.SmartArt.AllNodes | |
oNode.TextFrame2.TextRange.LanguageID = lang | |
Next | |
Else | |
oShape.TextFrame.TextRange.LanguageID = lang | |
For c = 0 To oShape.GroupItems.Count - 1 | |
oShape.GroupItems(c).TextFrame.TextRange.LanguageID = lang | |
Next | |
End If | |
Next | |
End Function | |
Function LangStr2Mso(langStr As String) As Integer | |
' Edit to extend languages supported | |
If langStr = "US" Then | |
LangStr2Mso = msoLanguageIDEnglishUS | |
ElseIf langStr = "UK" Then | |
LangStr2Mso = msoLanguageIDEnglishUK | |
ElseIf langStr = "DE" Then | |
LangStr2Mso = msoLanguageIDGerman | |
ElseIf langStr = "FR" Then | |
LangStr2Mso = msoLanguageIDFrench | |
End If | |
End Function |
Ribbon/ Buttons
You can add some buttons in the Ribbon to access this functionality.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
'------ | |
' Subs used by Ribbon Buttons OnClick Callback | |
' OnClick property must be one single string - can not pass lang argument | |
Sub SetLangUS() | |
Call SetLang("US") | |
End Sub | |
Sub SetLangUK() | |
Call SetLang("UK") | |
End Sub | |
Sub SetLangDE() | |
Call SetLang("DE") | |
End Sub | |
Sub SetLangFR() | |
Call SetLang("FR") | |
End Sub | |
'-------- |
I use this Ribbon Editor to setup customize / add buttons to the ribbon. (comment if you want me to make a detailed tutorial about how to use it.)
Usage
When you run such macros you will be asked if you want to change the presentation for the whole presentation or only the selected slides.