vba를 사용하여 텍스트 번역

vba를 사용하여 텍스트 번역

아마도 드문 청원일 수도 있지만, 여기 문제가 있습니다.

저는 타사의 엑셀을 제 조직에 적용하고 있습니다.엑셀은 영어로 개발되었고 우리 회사 사람들은 스페인어만 합니다.저는 원래 워크시트와 동일한 코드를 사용하고 싶습니다. 저는 그것을 만지지 않는 것을 선호합니다. 그래서 저는 그 메시지 상자가 나타날 때마다 (영어로 된 텍스트와 함께) 원래 스크립트를 건드리지 않고 메시지 상자 메시지를 번역하는 기능을 사용하고 싶습니다.저는 원래 코드에서 메시지박스가 호출될 때마다 호출될 수 있는 마스크를 찾고 있습니다.

저는 원래 코드를 만지지 않는 것을 선호합니다. 왜냐하면 서드파티 개발자가 코드를 자주 변경할 수 있고, 약간의 변경을 할 때마다 코드를 변경하는 것은 매우 귀찮을 수 있기 때문입니다.

그게 가능한가요?

여기 있어요.

Sub test()
    Dim s As String
    s = "hello world"
    MsgBox translate_using_vba(s)

End Sub

Function translate_using_vba(str) As String
' Tools Refrence Select Microsoft internet Control


    Dim IE As Object, i As Long
    Dim inputstring As String, outputstring As String, text_to_convert As String, result_data As String, CLEAN_DATA

    Set IE = CreateObject("InternetExplorer.application")
    '   TO CHOOSE INPUT LANGUAGE

    inputstring = "auto"

    '   TO CHOOSE OUTPUT LANGUAGE

    outputstring = "es"

    text_to_convert = str

    'open website

    IE.Visible = False
    IE.navigate "http://translate.google.com/#" & inputstring & "/" & outputstring & "/" & text_to_convert

    Do Until IE.ReadyState = 4
        DoEvents
    Loop

    Application.Wait (Now + TimeValue("0:00:5"))

    Do Until IE.ReadyState = 4
        DoEvents
    Loop

    CLEAN_DATA = Split(Application.WorksheetFunction.Substitute(IE.Document.getElementById("result_box").innerHTML, "</SPAN>", ""), "<")

    For j = LBound(CLEAN_DATA) To UBound(CLEAN_DATA)
        result_data = result_data & Right(CLEAN_DATA(j), Len(CLEAN_DATA(j)) - InStr(CLEAN_DATA(j), ">"))
    Next


    IE.Quit
    transalte_using_vba = result_data


End Function

Excel VBA 및 Google을 보다 효율적으로 사용할 수 있는 방법은 다음과 같습니다.텍스트를 번역합니다.

이 VBA 사용자 정의 기능은 표준 코드 모듈에 입력해야 합니다.

Function Translate$(sText$, FromLang$, ToLang$)
    Dim p1&, p2&, url$, resp$
    Const DIV_RESULT$ = "<div class=""result-container"">"
    Const URL_TEMPLATE$ = "https://translate.google.com/m?hl=[from]&sl=[from]&tl=[to]&ie=UTF-8&prev=_m&q="
    url = URL_TEMPLATE & WorksheetFunction.EncodeURL(sText)
    url = Replace(url, "[to]", ToLang)
    url = Replace(url, "[from]", FromLang)
    resp = WorksheetFunction.WebService(url)
    p1 = InStr(resp, DIV_RESULT)
    If p1 Then
        p1 = p1 + Len(DIV_RESULT)
        p2 = InStr(p1, resp, "</div>")
        Translate = Mid$(resp, p1, p2 - p1)
    End If
End Function

에 포함A1:Every moment is a fresh beginning.

셀B1다음 공식을 입력합니다.

=Translate(A1, "en", "fr")    '<--translates text in A1 from English to French.

는 세포 에서 발생합니다.B1:Chaque instant est un nouveau départ.

이 물론이은것은것▁of이.Translate()기능은 VBA에서 직접 사용할 수도 있습니다.

MsgBox Translate([A1], "en", "de")  '<--displays: Jeder Moment ist ein Neuanfang.

물론 리본의 검토 탭에 있는 Excel에 내장된 번역 기능을 수동으로 사용할 수도 있습니다.그러나 위의 UDF는 텍스트를 프로그래밍 방식으로 번역하는 빠르고 효율적인 방법을 제공합니다.Excel의 번역 기능은 Excel Object Model을 통해 노출되지 않으므로 위와 같은 기능이 매우 유용할 수 있습니다.

그FromLang그리고.ToLang인수는 다음 테이블의 코드여야 합니다.

 CODE   LANGUAGE
 en     English
 fr     French
 es     Spanish
 it     Italian
 de     German
 af     Afrikaans
 sq     Albanian
 am     Amharic
 ar     Arabic
 hy     Armenian
 az     Azerbaijani
 eu     Basque
 be     Belarusian
 bn     Bengali
 bs     Bosnian
 bg     Bulgarian
 ca     Catalan
 ceb    Cebuano
 ny     Chichewa
 zh-CN  Chinese (Simplified)
 zh-TW  Chinese (Traditional)
 co     Corsican
 hr     Croatian
 cs     Czech
 da     Danish
 nl     Dutch
 eo     Esperanto
 et     Estonian
 tl     Filipino
 fi     Finnish
 fy     Frisian
 gl     Galician
 ka     Georgian
 el     Greek
 gu     Gujarati
 ht     Haitian Creole
 ha     Hausa
 haw    Hawaiian
 iw     Hebrew
 hi     Hindi
 hmn    Hmong
 hu     Hungarian
 is     Icelandic
 ig     Igbo
 id     Indonesian
 ga     Irish
 ja     Japanese
 jw     Javanese
 kn     Kannada
 kk     Kazakh
 km     Khmer
 rw     Kinyarwanda
 ko     Korean
 ku     Kurdish (Kurmanji)
 ky     Kyrgyz
 lo     Lao
 la     Latin
 lv     Latvian
 lt     Lithuanian
 lb     Luxembourgish
 mk     Macedonian
 mg     Malagasy
 ms     Malay
 ml     Malayalam
 mt     Maltese
 mi     Maori
 mr     Marathi
 mn     Mongolian
 my     Myanmar (Burmese)
 ne     Nepali
 no     Norwegian
 or     Odia (Oriya)
 ps     Pashto
 fa     Persian
 pl     Polish
 pt     Portuguese
 pa     Punjabi
 ro     Romanian
 ru     Russian
 sm     Samoan
 gd     Scots Gaelic
 sr     Serbian
 st     Sesotho
 sn     Shona
 sd     Sindhi
 si     Sinhala
 sk     Slovak
 sl     Slovenian
 so     Somali
 su     Sundanese
 sw     Swahili
 sv     Swedish
 tg     Tajik
 ta     Tamil
 tt     Tatar
 te     Telugu
 th     Thai
 tr     Turkish
 tk     Turkmen
 uk     Ukrainian
 ur     Urdu
 ug     Uyghur
 uz     Uzbek
 vi     Vietnamese
 cy     Welsh
 xh     Xhosa
 yi     Yiddish
 yo     Yoruba
 zu     Zulu

이렇게 하면 됩니다.구글 번역에서 사용하는 언어 코드를 가리키는 선택적 열거 객체와 함께 기능합니다.간단한 설명을 위해 몇 가지 언어 코드만 포함했습니다.또한 이 샘플에서 Microsoft Internet Controls 참조를 선택하여 개체를 만드는 대신 Internet Explorer 개체가 사용됩니다.그리고 마지막으로 출력을 정리해야 하는 번거로움을 없애기 위해 .innerHTML 대신 .innerText를 사용했습니다. 구글 번역에는 약 3000자 정도의 문자 제한이 있습니다. 또한, 만약 당신이 이것을 여러 번 사용한다면, 당신은 IE=아무것도 설정하지 말아야 합니다.그렇지 않으면 여러 IE 프로세스를 생성하고 결국 더 이상 작동하지 않습니다.

설정...

Option Explicit

Const langCode = ("auto,en,fr,es")

Public Enum LanguageCode
    InputAuto = 0
    InputEnglish = 1
    InputFrench = 2
    InputSpanish = 3
End Enum

Public Enum LanguageCode2
    ReturnEnglish = 1
    ReturnFrench = 2
    ReturnSpanish = 3
End Enum

테스트...

Sub Test()

Dim msg As String

msg = "Hello World!"

MsgBox AutoTranslate(msg, InputEnglish, ReturnSpanish)

End Sub

함수...

Public Function AutoTranslate(ByVal Text As String, Optional LanguageFrom As LanguageCode, Optional LanguageTo As LanguageCode2) As String

Dim langFrom As String, langTo As String, IE As InternetExplorer, URL As String, myArray

If IsMissing(LanguageFrom) Then
    LanguageFrom = InputAuto
End If
If IsMissing(LanguageTo) Then
    LanguageTo = ReturnEnglish
End If

myArray = Split(langCode, ",")
langFrom = myArray(LanguageFrom)
langTo = myArray(LanguageTo)

URL = "https://translate.google.com/#" & langFrom & "/" & langTo & "/" & Text

Set IE = New InternetExplorer

IE.Visible = False
IE.Navigate URL

    Do Until IE.ReadyState = 4
        DoEvents
    Loop

    Application.Wait (Now + TimeValue("0:00:5"))

    Do Until IE.ReadyState = 4
        DoEvents
    Loop

    AutoTranslate = IE.Document.getElementByID("result_box").innerText

    IE.Quit

    Set IE = Nothing


End Function

Google 번역 API를 사용하여 Google 번역 API를 사용하는 최신 솔루션 중 하나인 Google 번역 API를 사용하려면 먼저 프로젝트와 자격 증명을 만들어야 합니다.403(일별 한도)을 받으시면 구글 클라우드 계정에 결제 수단을 추가하셔야 결과가 즉시 나옵니다.

Private Function GoogleTranslateJ(ByVal text, ByVal resLang, ByVal srcLang) As String
Dim jsonProvider As Object

Dim jsonResult As Object
Dim jsonResultText As String

Dim googleApiUrl As String
Dim googleApiKey As String

Dim resultText As String

Set jsonProvider = CreateObject("MSXML2.ServerXMLHTTP")

text = Replace(text, " ", "%20")
googleApiKey = "ijHF28h283fjijefiwjeofij90f2h923" 'YOUR GOOGLE API KEY

googleApiUrl = "https://translation.googleapis.com/language/translate/v2?key=" & googleApiKey & "&source=" & srcLang & "&target=" & resLang & "&q=" & text

jsonProvider.Open "POST", googleApiUrl, False
jsonProvider.setRequestHeader "Content-type", "application/text"
jsonProvider.send ("")
jsonResultText = jsonProvider.responseText

Set jsonResult = JsonConverter.ParseJson(jsonResultText)
Set jsonResult = jsonResult("data")
Set jsonResult = jsonResult("translations")
Set jsonResult = jsonResult(1)

resultText = jsonResult("translatedText")

GoogleTranslateJ = resultText
End Function

업데이트: 개선됨For Each v In arr_Response-sys, 특수 문자를 사용할 수 있습니다.변환이 처리될 때 마우스 커서 변경 사항이 추가되었습니다.변환된 output_string을 개선하는 방법에 대한 예제가 추가되었습니다.

무료 번역 API의 대다수가 있지만, 구글 번역 서비스, GTS를 능가하는 것은 아무도 없는 것 같습니다(제 생각에는).무료 GTS 사용에 대한 Google의 제한으로 인해 최상의 VBA 접근 방식은 IE.내비게이션으로 좁혀지는 것으로 보입니다. - Santosh의 답변에서도 강조하고 있습니다.

이 접근 방식을 사용하면 몇 가지 문제가 발생합니다.IE-instans는 페이지가 완전히 로드된 시점과 IE를 알지 못합니다.ReadyState는 정말 신뢰할 수 없습니다.는 "지연"을 사용하여 "지연.Application.Wait기능. 이때까지 입니다.이 기능을 사용할 때는 페이지가 완전히 로드될 때까지 얼마나 걸릴지 추측하는 것뿐입니다.인터넷 속도가 매우 느린 상황에서는 하드 코딩된 이 시간으로는 충분하지 않을 수 있습니다.다음 코드는 향상된 준비 상태를 사용하여 이 문제를 해결합니다.

시트에 다른 열이 있고 각 셀에 다른 변환을 추가하려는 경우 공식 내에서 VBA-Function을 호출하는 대신 변환 문자열이 ClipBoard에 할당되는 최상의 방법을 찾습니다.따라서 번역을 쉽게 붙여넣고 문자열로 수정할 수 있습니다.

사용 방법:

1. 사용자 지정 VBA 모듈에 절차 삽입
2. 4 Const를 원하는 대로 변경합니다(상단 참조).TranslationText)
3. 바로 가기 키를 할당하여 다음을 시작합니다.TranslationText

4. 변환할 셀을 활성화합니다.첫 번째 행이 언어 태그로 끝나야 합니다.예를 들어 "_da", "_en", "_de" 등입니다.다른 기능을 원하는 경우 변경할 수 있습니다.ws_ActiveWS.Cells(r_ActiveCell.Row, r_InputRange.Column)

5. 4. (예: CTRL + SHIFT + S)의 단축키를 누릅니다.프로세스 표시줄(Excel 하단)의 프로세스를 참조하십시오.변환이 완료되면 붙여넣기(CTRL+V):

    Option Explicit

    'Description: Translates content, and put the translation into ClipBoard
    'Required References: MIS (Microsoft Internet Control)
    Sub TranslateText()

    'Change Const's to your desire
    Const INPUT_RANGE As String = "table_products[productname_da]"
    Const INPUT_LANG As String = "da"
    Const PROCESSBAR_INIT_TEXT As String = "Processing translation. Please wait... "
    Const PROCESSBAR_DONE_TEXT As String = "Translation done. "

    Dim ws_ActiveWS As Worksheet
    Dim r_ActiveCell As Range, r_InputRange As Range
    Dim s_InputStr As String, s_InputLang As String, s_OutputLang As String, arr_Response() As String, s_Translation As String
    Dim o_IE As Object, o_MSForms_DataObject As Object
    Dim i As Long
    Dim v As Variant

    Set o_MSForms_DataObject = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Set ws_ActiveWS = ThisWorkbook.ActiveSheet
    Set r_ActiveCell = ActiveCell
    Set o_IE = CreateObject("InternetExplorer.Application")
    Set r_InputRange = ws_ActiveWS.Range(INPUT_RANGE)

    'Update statusbar ("Processing translation"), and change cursor
    Application.Statusbar = PROCESSBAR_INIT_TEXT
    Application.Cursor = xlWait

    'Declare inputstring (The string you want to translate from)
    s_InputStr = ws_ActiveWS.Cells(r_ActiveCell.Row, r_InputRange.Column)

    'Find the output-language
    s_OutputLang = Right(ws_ActiveWS.Cells(1, r_ActiveCell.Column).Value, 2)

    'Navigate to translate.google.com
    With o_IE

        .Visible = False 'Run IE in background
        .Navigate "http://translate.google.com/#" & INPUT_LANG & "/" _
            & s_OutputLang & "/" & s_InputStr

        'Call improved IE.ReadyState
        Do
            ImprovedReadyState
        Loop Until Not .Busy

        'Split the responseText from Google
        arr_Response = Split(.Document.getElementById("result_box").innerHTML, "<span class")

        'Remove html from response, and construct full-translation-string
        For Each v In arr_Response
            s_Translation = s_Translation & Replace(v, "<span>", "")
            s_Translation = Replace(s_Translation, "</span>", "")
            s_Translation = Replace(s_Translation, """", "")
            s_Translation = Replace(s_Translation, "=hps>", "")
            s_Translation = Replace(s_Translation, "=atn>", "")
            s_Translation = Replace(s_Translation, "=hps atn>", "")

            'Improve translation.
            'This could etc. be moved to seperate sheets (containing every language), and make the lookup in a dynamic table/sheet. Futurely it'd be possible to hook on the changeevent, and automatically improve the translation-algoritmen.
            'If Google can't translate the etc. the word "Lys", you can extend the translation, with an auto correction. This example shows to autocorrect the word "Lys" -> "ljus". 
            If (s_OutputLang = "sv") Then
                s_Translation = Replace(s_Translation, "lys", "ljus")
            End if
        Next v

        'Put Translation into Clipboard
        o_MSForms_DataObject.SetText s_Translation
        o_MSForms_DataObject.PutInClipboard

        If (s_Translation <> vbNullString) Then
            'Put Translation into Clipboard
            o_MSForms_DataObject.SetText s_Translation
            o_MSForms_DataObject.PutInClipboard

            'Update statusbar ("Translation done"). If the input_string is above 70 chars (which is roughly the limitation in processbar), then cut the string, and extend with "...".
            Application.Statusbar = PROCESSBAR_DONE_TEXT & """" & IIf(Len(s_InputStr) < 70, s_InputStr, Mid(s_InputStr, 1, 70) & "...") & """"
        Else
            'Update statusbar ("Error")
            Application.Statusbar = PROCESSBAR_ERROR_TEXT
        End If

        'Cleanup
        .Quit

        'Change cursor back to default
        Application.Cursor = xlDefault

        Set o_MSForms_DataObject = Nothing
        Set ws_ActiveWS = Nothing
        Set r_ActiveCell = Nothing
        Set o_IE = Nothing

    End With

End Sub

Sub ImprovedReadyState()

    Dim si_PauseTime As Single: si_PauseTime = 1 'Set duration
    Dim si_Start As Single: si_Start = Timer 'Set start-time
    Dim si_Finish As Single 'Set end-time
    Dim si_TotalTime As Single 'Calculate total time.

    Do While Timer < (si_Start + si_PauseTime)
        DoEvents
    Loop

    si_Finish = Timer

    si_TotalTime = (si_Finish - si_Start)

End Sub

저에게 최고의 대답은 엑셀 히어로입니다.단순하고 직접적이며 무엇보다도 API를 사용할 필요가 없습니다.나는 왜 그것이 더 많은 표를 가지고 있지 않은지 이해할 수 없습니다.

응답의 일부 요소를 수정하려면 결과를 필터링해야 합니다.

Function ClearResponse(ByVal text As String) As String

text = Replace(text, """, """")
text = Replace(text, "%2C", ",")
text = Replace(text, "'", "'")

ClearResponse = text

End Function 'ClearResponse

유니코가 올린 답은 훌륭합니다!

테이블 물건을 제거하고 단일 셀로 작업하게 했지만 결과는 동일합니다.

제가 번역하는 텍스트 중 일부(제조 환경에서의 작업 지침)를 사용하여 Google은 때때로 반환 문자열에 쓰레기를 추가하고, 때로는 추가적인 <span> 구조를 사용하여 응답을 두 배로 늘리기도 합니다.

'Next v' 직후에 코드에 다음 행을 추가했습니다.

s_Translation = RemoveSpan(s_Translation & "")

그리고 이 기능을 만들었습니다(같은 모듈에 추가).

Private Function RemoveSpan(Optional InputString As String = "") As String

Dim sVal As String
Dim iStart As Integer
Dim iEnd As Integer
Dim iC As Integer
Dim iL As Integer

If InputString = "" Then
    RemoveSpan = ""
    Exit Function
End If

sVal = InputString

' Look for a "<span"
iStart = InStr(1, sVal, "<span")

Do While iStart > 0 ' there is a "<span"
    iL = Len(sVal)
    For iC = iStart + 5 To iL
        If Mid(sVal, iC, 1) = ">" Then Exit For ' look for the first ">" following the "<span"
    Next
    If iC < iL Then ' then we found a "<"
        If iStart > 1 Then ' the "<span" was not in the beginning of the string
            sVal = Left(sVal, iStart - 1) & Right(sVal, iL - iC) ' grab to the left of the "<span" and to the right of the ">"
        Else ' the "<span" was at the beginning
            sVal = Right(sVal, iL - iC) ' grap to the right of the ">"
        End If
    End If
    iStart = InStr(1, sVal, "<span") ' look for another "<span"
Loop
    RemoveSpan = sVal
End Function

돌이켜보면, 저는 제가 이것을 더 효율적으로 할 수 있었다는 것을 깨달았지만, 그것은 효과가 있고 저는 앞으로 나아가고 있습니다!

언급URL : https://stackoverflow.com/questions/19098260/translate-text-using-vba