Search code examples
vbapowerpointpowerpoint-2013

VBA Powerpoint 2013: change presentation language including SmartArt objects


I can not find a way to change by VBA script the language in SmartArt objects in Powerpoint 2013. I've seen PowerPoint 2007 - Set language on tables, charts etc that contains text but it does not work for SmartArt objects. Any idea how I could do this? Many thanks.


Solution

  • This is the code I finally use to change the language including SmartArts:

    Sub SetLangUS()
      Call changeLanguage(ActivePresentation, "US")
    End Sub
    
    Sub SetLangDE()
      Call changeLanguage(ActivePresentation, "DE")
    End Sub
    
    
    
    Private Function changeLanguage(oPres As Presentation, langStr As String)
    ' Reference http://stackoverflow.com/questions/4735765/powerpoint-2007-set-language-on-tables-charts-etc-that-contains-text
    ' https://support.microsoft.com/en-us/kb/245468
    
        On Error Resume Next
    
        Dim r, c As Integer
        Dim oSlide As Slide
        Dim oNode As SmartArtNode
        Dim oShape, oNodeShape As Shape
        Dim lang As String
    
        'lang = "Norwegian"
        'Determine language selected
        If langStr = "US" Then
            lang = msoLanguageIDEnglishUS
        ElseIf langStr = "UK" Then
            lang = msoLanguageIDEnglishUK
        ElseIf langStr = "DE" Then
            lang = msoLanguageIDGerman
        ElseIf langStr = "FR" Then
            lang = msoLanguageIDFrench
        End If
    
        'Set default language in application
        oPres.DefaultLanguageID = lang
    
        'Set language in each textbox in each slide
        For Each oSlide In oPres.Slides
            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
        Next
    
        ' Update Masters
        For Each oShape In oPres.SlideMaster.Shapes
            oShape.TextFrame.TextRange.LanguageID = lang
        Next
    
        For Each oShape In oPres.TitleMaster.Shapes
            oShape.TextFrame.TextRange.LanguageID = lang
        Next
    
        For Each oShape In oPres.NotesMaster.Shapes
            oShape.TextFrame.TextRange.LanguageID = lang
        Next
    
        ' MsgBox
        MsgBox "Presentation Language was changed to " & langStr & ".", vbOKOnly, "SetLanguage"
    
    
    End Function