#VBA: Export #PowerPoint to Portable Object (PO) File

One of my current tasks is to translate a large PowerPoint slide deck with more than 200 slides from English to German. The problem is that the slides are “a work in progress.” Therefore, a nice-to-have approach would be to export all strings from the slides to a Portable Object (PO) file, translate them with a PO editor, such as Gtranslator, and then create a localized PowerPoint file using the translated strings. If the PowerPoint changes, all translations can be reused. Only new and modified strings need to be translated. This article describes the first step – the extraction of the PowerPoint strings into the PO file.

The code is implemented as a VBA macro that can be added to the PowerPoint file. It is compatible with the Windows version of PowerPoint (that means, it is not working with Office 2011 for Mac or Office with CrossOver).

Sub Export2PO()
 
    Dim s As Integer
    Dim slide As PowerPoint.slide
    Dim s2 As Integer
    Dim shape As PowerPoint.shape
    Dim txtFrame
    Dim txtRange
    Dim paras
    Dim p As Integer
    Dim para As PowerPoint.textRange
    Dim txt As String
 
    Dim fso As FileSystemObject
    Dim stream As TextStream
 
    On Error Resume Next
 
    Set fso = New FileSystemObject
    'MsgBox (ActivePresentation.Path & "" & ActivePresentation.Name & ".po")
    Set stream = fso.CreateTextFile(ActivePresentation.Path & "" & ActivePresentation.Name & ".po", True)
 
    ' Write PO header
    stream.WriteLine ("msgid """"")
    stream.WriteLine ("msgstr """"")
    stream.WriteLine ("""Content-Type: text/plain; charset=utf-8n""")
 
    With Application.ActiveWindow.Presentation
        For s = 1 To .Slides.Count
            Set slide = .Slides(s)
            With .Slides(s)
 
                For s2 = 1 To .Shapes.Count
                    If .Shapes(s2).HasTextFrame Then
                        Set shape = .Shapes(s2)
                        Set txtFrame = shape.textFrame
                        Set txtRange = txtFrame.textRange
 
                        With txtRange.paragraphs(-1, -1)
                            For p = 1 To .Count
                                Set para = txtRange.paragraphs(p)
                                txt = para.Text
 
                                If txt <> "?" Then
                                    stream.WriteLine "msgctxt " & """" & slide.Name & """"
                                    'txt = Replace(txt, Chr(13), "")
                                    'txt = Replace(txt, Chr(10), "")
                                    txt = Replace(txt, """", """" & """")
 
                                    stream.WriteLine "msgid " & """" & txt & """"
                                    stream.WriteLine "msgstr " & """" & "" & """"
                                End If
                            Next
                        End With
                    End If
                Next
            End With
        Next
    End With
 
    stream.Close
End Sub

My next posting fill cover generating the translated PowerPoint file using a translated PO file.

Leave a Reply

Your email address will not be published. Required fields are marked *