How to – powerpoint change default language on all slides Capitol I

Motivele pentru care am facut acest tutorial le gasiti aici.

Ca sa recapitula de ce avem nevoie: MS office 2010 cu Proofing Tools si/sau Multi Lang Pack.
Tutorialul explica situatia in care avem un fisier PowerPoint cu text in romana iar Language Default este setat in engleza si dorim sa modificam in romana. Binenteles ca se poate aplica si pentru alte “languages” (in RO nu suna prea bine 🙂 ), cu conditia sa avem instalat Proofing Tools si/sau Multi Lang Pack.

Continuarea cu cele 2 noi capitole le gasiti aici:
II. Implementarea a celor 2 fisiere  .ppam si .pptm in MS Office (PowerPoint)
III. Utilizarea tool-ului

I. Generat fisiere .ppam si .pptm:

1. languageAddin.ppam pt Add-ins  (adaugat in bara de meniu).
2. language.pptm  pentru a executa macro

1. languageAddin.ppam

a). Deschide PowerPoint-ul si salveaza un un fisier nou cu extensia  .pptm (languageAddin.pptm) in folderul My Documents (calea unde salvam este irelevanta).

selectam File/Save as iar la Save as Type alagem Powerpoint Macro Enebled Pesentation (*.pptm)

b). Adaugarea cod VB.
Deschidem interfata Visual Basic cu ajutoarul tastelor Alt-F11 si adaugam un nou modul folosind una din cele 2 metode:

metoda clasica din meniul Insert/Module
 

sau click dreapta pe VBAProject (Language.pptm) si selectam Insert/Module

Adaugam urmatorul cod in noul modul creat:

Sub Auto_Open()
'Note this will only fire automatically when in a loaded Add-in.
'
    Dim strFileName As String
   
     'Path for file with macros:
    strFileName = CStr(Environ("USERPROFILE")) & "\Application Data\Microsoft\AddIns\language.pptm"
   
     'Open the presentation with macros, but keep it hidden:
    Application.Presentations.Open FileName:=strFileName, WithWindow:=msoFalse
End Sub

c). Salvati si iesiti din interfata Visual Basic.

Din interfata PowerPoint salvati fiserul cu extensia .ppam. Selectati din meniu File/Save As iar la Save as Type alagem PowerPoint Add-in (*.ppam).

Acesta se va salva automat in locatia default a directorului  “AddIns” din profilul utilizatorului (%APPDATA%\Microsoft\AddIns), sau:

windows 7 :
%userprofile%\AppData\Roaming\Microsoft\AddIns
windows XP:
%userprofile%\Application Data\Microsoft\AddIns

2. language.ppam

a). Deschide PowerPoint-ul si salveaza un un fisier nou cu extensia  .pptm (language.pptm) in folderul My Documents (calea unde salvam este irelevanta).

selectam File/Save as iar la Save as Type alagem Powerpoint Macro Enebled Pesentation (*.pptm)

 b). Adaugarea cod VB.

Deschidem interfata Visual Basic cu ajutoarul tastelor Alt-F11 si adaugam un nou modul folosind una din cele 2 metode:

metoda clasica din meniul Insert/Module

 sau click dreapta pe VBAProject (Language.pptm) si selectam Insert/Module

Adaugam urmatorul cod in noul modul creat:

Sub SetLangaugeFromSelection()
    Dim lang As Office.MsoLanguageID
    lang = -9999

    On Error Resume Next
    lang = Application.ActiveWindow.Selection.ShapeRange.TextFrame.TextRange.languageID
    On Error GoTo 0

    If lang = -9999 Then
        MsgBox ("Please select a text object from which the language should be copied")
    ElseIf lang < 0 Then
        MsgBox ("Invalid language code. Please apply a language to the entire text field, then try again.")
    Else
        Dim res As VbMsgBoxResult
        res = MsgBox("Copy language setting from selection to entire presentation?", VbMsgBoxStyle.vbYesNo)
        If (res = VbMsgBoxResult.vbYes) Then
            SetLanguageTo (lang)
        End If
    End If
End Sub

Sub SetLanguageTo(lang As Office.MsoLanguageID)
    Dim pres As Presentation
    
    Set pres = ActivePresentation

    pres.DefaultLanguageID = lang

    ' Fix slides
    Dim slide As PowerPoint.slide
    For Each slide In pres.Slides
        SetLanguageOnShapes slide.Shapes, lang
    Next

    ' Fix slide master
    Dim customLayout As PowerPoint.customLayout
    SetLanguageOnShapes pres.SlideMaster.Shapes, lang
    For Each customLayout In pres.SlideMaster.CustomLayouts
        SetLanguageOnShapes customLayout.Shapes, lang
    Next

    ' Fix other masters
    SetLanguageOnShapes pres.HandoutMaster.Shapes, lang
    SetLanguageOnShapes pres.NotesMaster.Shapes, lang
    If pres.HasTitleMaster Then SetLanguageOnShapes pres.TitleMaster.Shapes, lang

End Sub

Sub SetLanguageOnShapes(Shapes As PowerPoint.Shapes, languageID As Office.MsoLanguageID)
    Dim shape As PowerPoint.shape
    For Each shape In Shapes
        SetLanguageOnShape shape, languageID
    Next
End Sub

Sub SetLanguageOnShape(shape As PowerPoint.shape, languageID As Office.MsoLanguageID)
    If shape.HasTextFrame Then
        On Error Resume Next ' this sometimes fails for complex objects
        shape.TextFrame.TextRange.languageID = languageID
        On Error GoTo 0
    End If

    If shape.HasTable Then
        Dim r, c As Integer
        For r = 1 To shape.Table.Rows.Count
            For c = 1 To shape.Table.Columns.Count
                SetLanguageOnShape shape.Table.Cell(r, c).shape, languageID
            Next
        Next
    End If

    On Error GoTo NotAGroup ' enable error handling. multiple types have groupItems, and only way to check is to try
    If Not shape.GroupItems.Count > 0 Then GoTo NotAGroup
    On Error GoTo 0 ' disable error handling

    Dim itemShape As PowerPoint.shape
    For Each itemShape In shape.GroupItems
        SetLanguageOnShape itemShape, languageID
    Next
NotAGroup:

End Sub 

Vezi oferta celor de la emag aici pentru Ms Office. Info despre aplicatii alternative gratuite la MS Office gasiti aici.

Continuarea cu cele 2 noi capitole le gasiti aici:
II. Implementarea a celor 2 fisiere  .ppam si .pptm in MS Office (PowerPoint)
III. Utilizarea tool-ului