Sprawdzanie pisowni w PowerPointcie – czyli jak zmienić język na wszystkich slajdach

Zastanawiam się jak często u Was trafia się taka mała rzecz, która mocno irytuje i myślicie, że nie można z nią nic zrobić. U mnie takim czymś było sprawdzanie pisowni w PowerPoint-cie. Obecnie wydaje mi się, że robiąc jakąkolwiek prezentację jedynym słusznym wyborem jest zrobienie jej w języku angielskim. I tu pojawia się drobna niedogodność w programie PowerPoint. Sprawdzanie pisowni potrafi płatać figle:

Jak widzicie cały slajd jest po angielsku. Na potrzeby tego artykułu dodałem jedno zdanie, z którym nie poradził sobie PowerPoint. Na całym angielskim slajdzie stwierdził, że nowy tekst jest po polsku. Generalnie jest to dość częste zachowanie. Rozwiązaniem tego problemu jest poprawienie każdego elementu, do którego nie jest poprawnie przypisany język i ustawienie interesującego nas języka.

Ostatnio stwierdziłem jednak, że tracę na tą czynność zbyt dużo czasu i postanowiłem rozwiązać ten problem w sposób bardziej automatyczny. Opis algorytmu w zasadzie został przedstawiony i pozostało mi znalezienie sposobu na jego automatyzację.

Z pomocą przychodzi VBA. Wystarczy proste makro, które wykona te czynności za nas:

Sub ChangeProofingLanguageToEnglish()
  Dim j, k As Integer
  Dim languageID As MsoLanguageID

  'Set this to your preferred language
  languageID = msoLanguageIDEnglishUK

  'Loop all the slides in the document, and change the language
  For j = 1 To ActivePresentation.Slides.Count
    For k = 1 To ActivePresentation.Slides(j).Shapes.Count
      ChangeAllSubShapes ActivePresentation.Slides(j).Shapes(k), languageID
    Next k
  Next j

  'Loop all the master slides, and change the language
  For j = 1 To ActivePresentation.SlideMaster.CustomLayouts.Count
    For k = 1 To ActivePresentation.SlideMaster.CustomLayouts(j).Shapes.Count
      ChangeAllSubShapes ActivePresentation.SlideMaster.CustomLayouts(j).Shapes(k), languageID
    Next k
  Next j

  'Change the default presentation language, so that all new slides respect the new language
  ActivePresentation.DefaultLanguageID = languageID
End Sub

Sub ChangeAllSubShapes(targetShape As Shape, languageID As MsoLanguageID)
  Dim i As Integer, r As Integer, c As Integer
  If targetShape.HasTextFrame Then
    targetShape.TextFrame.TextRange.languageID = languageID
  End If

  If targetShape.HasTable Then
    For r = 1 To targetShape.Table.Rows.Count
      For c = 1 To targetShape.Table.Columns.Count
        targetShape.Table.Cell(r, c).Shape.TextFrame.TextRange.languageID = languageID
      Next
    Next
  End If

  Select Case targetShape.Type
    Case msoGroup, msoSmartArt
      For i = 1 To targetShape.GroupItems.Count
        ChangeAllSubShapes targetShape.GroupItems.Item(i), languageID
      Next i
  End Select
End Sub

Pamiętajcie tylko, że makro to musi zostać wrzucone do modułu. I oczywiście możemy zmienić język na inny niż angielski poprzez modyfikację linii:

languageID = msoLanguageIDEnglishUK

Samo jego uruchomienie jest bardzo proste. Wystarczy wejść do zakładki Developer, otworzyć Makra i z listy uruchomić nasze makro:

Taka mała rzecz, a potrafi dość sporo czasu zaoszczędzić.

Check it:

Sprawdzanie wersji Excela Sprawdzanie dostępności sieci