구글번역을 이용한 PPT 슬라이드 자동 번역

구글API나 MS API를 이용할 수 있겠으나 따로 승인절차가 있어서

여기서는 간단히 구글번역사이트의 결과HTML을 파싱하여

슬라이드를 번역하도록 해봤습니다.

 

 

사용법은 먼저 좌측 미리보기 창에서 원하는 슬라이드들을 모두 선택하고 나서

Alt-F8 이나 개발도구-매크로에서 TranslateSlides 매크로를 실행시키면 됩니다.

 

첨부파일을 열고 Alt-F11 로 열어보면 모듈에 매크로 소스가 있습니다.

 

 

 

여러 슬라이드 보기 상태에서도 똑같이 실행할 수 있습니다.

참고로 중국어, 러시아어, 아랍어 등을 시험삼아 넣어 봤습니다.

 

슬라이드가 많을 경우를 대비하여 진행상황을 알 수 있게 작업진행창(프로그레스바)를 넣었습니다.

 

 

작업결과입니다.

번역이 부드럽진 않지만 자동으로 번역이 되었습니다.

 

MS자체 번역기능이나 네이버 파파고를 이용한다든지 다른 번역을 이용해볼 수도 있겠습니다.

 

 

 

Option Explicit
 
Sub TranslateSlides()
    Dim sldRng As SlideRange
    Dim sld As Slide
    Dim shp As Shape
    Dim Txt As String
    Dim i As Long
    
    If ActiveWindow.Selection.Type <> ppSelectionSlides Then _
        MsgBox "좌측 미리보기 창에서 먼저 변환할 슬라이드(들)을 선택하세요.": Exit Sub
    Set sldRng = ActiveWindow.Selection.SlideRange
   
    UserForm1.Show vbModeless
    
    For Each sld In sldRng
    
        For Each shp In sld.Shapes
            
            If shp.HasTextFrame Then
                With shp.TextFrame.TextRange
                    '구글번역으로 기존 텍스트를 한글로 변환
                    Txt = Replace(.Text, "&", "") ' & 문자 제거
                    ' 빈 칸은 +로 대체
                    Txt = Replace(Txt, " ", "+")
                    .Text = GoogleTrans(Txt, "ko")  '한국어로 번역
                End With
            End If
        
        Next shp
        
        'Update Progress Bar
        i = i + 1
        UserForm1.Caption = "Translating " & i & " / " & sldRng.Count
        UserForm1.ProgressBar1.Value = CInt(i * 100 / sldRng.Count)
        
    Next sld
    
    Unload UserForm1
    
End Sub
 
Function GoogleTrans(str As String, lang_out As String) As String
' 미리 변수를 정의하려면 도구-참조에서 MSXML 과 MS Html Object 라이브러리에 체크
'
' to use early binding, goto Tools - References,
' check MSXML 6.0,  Microsoft HTML Object Library
 
    Dim URL As String
    Dim Http As Object  'MSXML2.ServerXMLHTTP
    Dim Html As Object  'HTMLDocument
    Dim elem As Object  'IHTMLElementCollection
    Dim lang_in As String
 
    Set Http = CreateObject("MSXML2.ServerXMLHTTP")
    Set Html = CreateObject("HTMLfile")
    'Set Http = New MSXML2.ServerXMLHTTP
    'Set HTML = New HTMLDocument
    
    'INPUT LANGUAGE
    lang_in = "auto" '"en, ko jp, cn, fr, es ...."
    
    'open mobile website since the mobile web site is much simpler....
    URL = "https://translate.google.com/m?hl=en&sl=" & lang_in _
            & "&tl=" & lang_out & "&ie=UTF-8&q=" & str
    'Example: https://translate.google.com/m?hl=en&sl=auto&tl=fr&ie=UTF-8&q=morning
    'Debug.Print URL
    With Http
        .Open "GET", URL, False
        .SetRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
        .Send
 
        Html.body.innerHTML = .ResponseText
        
    End With
    
    On Error GoTo SKip:
    'MsgBox Html.body.innerHTML
    'Set elem = HTML.getElementsByClassName("t0")   'late binding 의 경우 작동하지 않음.
    Set elem = IE8_GetElementsByClassName(Html.body, "t0")(0)
 
    GoogleTrans = elem.innerText
    
SKip:
    Set Html = Nothing
    Set Http = Nothing
    If Err.Number Then GoogleTrans = str: Debug.Print Err.Number, Err.Description
 
End Function
 
Function IE8_GetElementsByClassName(Html As Object, className As String, Optional Position As Integer)
'Function to return an array of matching classname elements
' or if specified will return a single HTMLElement by Position index
' by David Zemens (https://stackoverflow.com/users/1467082/david-zemens)
 
    Dim eleDict As Object
    Dim ele As Variant
    Dim x As Long, i As Long
    
    Set eleDict = CreateObject("Scripting.Dictionary")
    For x = 0 To Html.all.Length - 1
        Set ele = Html.all(x)
        If ele.className = className Then
            'Debug.Print i & vbTab & x & vbTab & ele.innerText
            Set eleDict(i) = ele
            i = i + 1
        End If
    Next
 
    If Position = Empty Then
        IE8_GetElementsByClassName = eleDict.Items
    Else
        Set IE8_GetElementsByClassName = eleDict(Position)
    End If
    Set eleDict = Nothing
End Function
 
'Sub testHttp()
'
'    MsgBox GoogleTrans("morning", "fr")
'
'End Sub
 
 

 

매크로를 허용해야 합니다.

 

파워포인트 버전간 호환성을 위해 Late Binding 을 굳이 이용하느라 소스가 길어졌습니다.

특히 GetElementsBy~ 함수가 Late Binding 을 한 경우에는 지원이 되지 않아

다른 유사함수를 가져와서 만드는라 더욱 길어졌습니다.

(Thanks to David Zemens at StackOverFlow.com)

 

미리 변수를 정의하는 Early Binding 을 이용하려면 

VBE매크로편집창에서 도구-참조에서 MSXML 4~6.0 과 MS Html Object 라이브러리에 체크하고

소스내의 Object 변수들을 모두 따로 선언해줘야 합니다.

 

첨부파일 참고하세요. 

( Download the following pptm file. You should enable macro contents when you open the file. )

 

구글번역예제1.pptm

다운로드

2020년 11월 수정본

(구글사이트 html변경으로 인한 수정본)

 

구글번역예제2.pptm

다운로드

 

2021년 9월 수정본

(텍스트박스내의 엔터키를 유지하기 위해 paragraph 단위로 처리하는 버전)

구글번역예제3.pptm

0.38MB

 

2022년 11월 수정본

(표인 경우와 그룹도형을 반영, 약간의 속도 개선한 버전)

구글번역예제4.pptm

0.39MB