Thursday, April 24, 2008

How to Set the Language in a PowerPoint presentation

To change the language of all text in all slides (including the Notes of the slides), use the following macro:

Sub SetLangUK()
'set language to UK for all slides and notes:
Dim scount, j, k, fcount
scount = ActivePresentation.Slides.Count
For j = 1 To scount
fcount = ActivePresentation.Slides(j).Shapes.Count
For k = 1 To fcount 'change all shapes:
If ActivePresentation.Slides(j).Shapes(k).HasTextFrame Then
ActivePresentation.Slides(j).Shapes(k).TextFrame _
.TextRange.LanguageID = msoLanguageIDEnglishUK
End If
Next k
'change notes:
fcount = ActivePresentation.Slides(j).NotesPage.Shapes.Count
For k = 1 To fcount 'change all shapes:
If ActivePresentation.Slides(j).NotesPage.Shapes(k).HasTextFrame Then
ActivePresentation.Slides(j).NotesPage.Shapes(k).TextFrame _
.TextRange.LanguageID = msoLanguageIDEnglishUK
End If
Next k
Next j
End Sub

I got half of this code from Antonín Otáhal and added the part about the NotesPage.

12 comments:

  1. Finlay!!!
    Thank you so much!!!!!!!!!!
    I can't believe I need a macro for sth like that.
    Stupid PowerPoint!

    ReplyDelete
    Replies
    1. Anonymous3:49 PM

      I don't understand nothing on programing but with a google search I found these 4 types of macros and with all of them finally I could change everything. Share with you all. My goal was to replace English to PORTUGUESE.

      »»» 1st: "Copy the code above"
      Public Sub changeLanguage()
      On Error Resume Next
      Dim gi As GroupShapes '<-this was added. used below
      'lang = "Portuguese"
      lang = "Portuguese"
      'Determine language selected
      If lang = "Portuguese" Then
      lang = msoLanguageIDPortuguese
      ElseIf lang = "Portuguese" Then
      lang = msoLanguageIDPortuguese
      End If
      'Set default language in application
      ActivePresentation.DefaultLanguageID = lang

      'Set language in each textbox in each slide
      For Each oSlide In ActivePresentation.Slides
      Dim oShape As Shape
      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
      Else
      Set gi = oShape.GroupItems
      'Check if it is a group of shapes
      If Not gi Is Nothing Then
      If oShape.GroupItems.Count > 0 Then
      For i = 0 To oShape.GroupItems.Count - 1
      oShape.GroupItems(i).TextFrame.TextRange.LanguageID = lang
      Next
      End If
      'it's none of the above, it's just a simple shape, change the language ID
      Else
      oShape.TextFrame.TextRange.LanguageID = lang
      End If
      End If
      Next
      Next
      End Sub

      »»»» 2nd : "Copy the code above"
      Sub changeTextObjectsLanguages()

      Const MYLANGID = msoLanguageIDPortuguese

      Dim sld As Slide
      Dim shps As Shapes
      Dim shp As Shape
      Dim prs As Presentation

      Set prs = ActivePresentation

      For Each sld In prs.Slides
      For Each shp In sld.Shapes
      If shp.TextFrame.HasText Then
      Debug.Print shp.Name, shp.TextFrame.HasText,

      On Error GoTo eh
      Debug.Print shp.TextFrame.TextRange.LanguageID,
      shp.TextFrame.TextRange.LanguageID = MYLANGID
      Debug.Print shp.TextFrame.TextRange.LanguageID

      End If

      cont:
      Next shp
      Next sld

      Exit Sub

      eh:
      Debug.Print "No LangId"
      Resume cont

      End Sub

      »»» 3th : "Copy the code above"
      Sub SetLangPT()
      'set language to PT for all slides and notes:
      Dim scount, j, k, fcount
      scount = ActivePresentation.Slides.Count
      For j = 1 To scount
      fcount = ActivePresentation.Slides(j).Shapes.Count
      For k = 1 To fcount 'change all shapes:
      If ActivePresentation.Slides(j).Shapes(k).HasTextFrame Then
      ActivePresentation.Slides(j).Shapes(k).TextFrame _
      .TextRange.LanguageID = msoLanguageIDPortuguese
      End If
      Next k
      'change notes:
      fcount = ActivePresentation.Slides(j).NotesPage.Shapes.Count
      For k = 1 To fcount 'change all shapes:
      If ActivePresentation.Slides(j).NotesPage.Shapes(k).HasTextFrame Then
      ActivePresentation.Slides(j).NotesPage.Shapes(k).TextFrame _
      .TextRange.LanguageID = msoLanguageIDPortuguese
      End If
      Next k
      Next j
      End Sub

      »»» 4th : "Copy the code above"
      Option Explicit
      Public Sub ChangeSpellCheckingLanguage()
      Dim j As Integer, k As Integer, scount As Integer, fcount As Integer
      scount = ActivePresentation.Slides.Count
      For j = 1 To scount
      fcount = ActivePresentation.Slides(j).Shapes.Count
      For k = 1 To fcount
      If ActivePresentation.Slides(j).Shapes(k).HasTextFrame Then
      ActivePresentation.Slides(j).Shapes(k) _
      .TextFrame.TextRange.LanguageID = msoLanguageIDPortuguese
      End If
      Next k
      Next j
      End Sub

      #HLPT

      Delete
  2. Brilliant! I cannot believe this is not a standard option in PowerPoint 2007.

    ReplyDelete
  3. Suzanne1:56 PM

    How do adapt the macro to set it for another language, like Dutch (Netherlands) or Spanish (Spain)?

    ReplyDelete
  4. Anonymous4:49 PM

    Warm thanks Anthonin and Demetris! This code is a real life saver.

    ReplyDelete
  5. Thank you, this just saved my presentation!

    ReplyDelete
  6. Anonymous12:33 PM

    Thank you so much!!!

    ReplyDelete
  7. Anonymous8:06 PM

    If Powerpoint was just launched by a start up company, it would get pretty bad reviews. And no-one would buy it.

    ReplyDelete
  8. Anonymous3:37 PM

    Thanks!! This is awesome...

    ReplyDelete
  9. Anonymous3:40 PM

    For those looking for alternate languages you can do a search for "msoLanguageID"
    or go to mricrosoft's page:
    http://msdn.microsoft.com/en-us/library/office/aa432635(v=office.12).aspx

    ReplyDelete
  10. Anonymous6:16 PM

    Absolutely great, thanks a lot. Also works with Hungarian which I needed

    ReplyDelete
  11. Anonymous2:57 PM

    Thanks a lot :)
    Really appreciate the code, very helpful.

    ReplyDelete