Giúp đỡ sửa code vba Translate thành Function! (1 người xem)

quyenpv · 10/3/13

Mình lang thang và tìm được code vba translate dành cho excel, trình độ có hạn nhờ các cao thủ sửa lại code trên thành 1 hàm có thể tùy biến ngôn ngữ thay vì phải chọn Combobox và nhấn buttom được không ạ

VD cú pháp hàm như sau:
translate(A1,"en","vi") ---> chuyển ngôn ngữ anh sang việt
translate(A1,"","vi") ------> chuyển ngôn ngữ tự phát hiện sang tiếng việt

Mong các cao thủ giúp đỡ hoàn thiện code

ndu96081631 · 10/3/13

quyenpv đã viết:
Mình lang thang và tìm được code vba translate dành cho excel, trình độ có hạn nhờ các cao thủ sửa lại code trên thành 1 hàm có thể tùy biến ngôn ngữ thay vì phải chọn Combobox và nhấn buttom được không ạ

VD cú pháp hàm như sau:
translate(A1,"en","vi") ---> chuyển ngôn ngữ anh sang việt
translate(A1,"","vi") ------> chuyển ngôn ngữ tự phát hiện sang tiếng việt

Mong các cao thủ giúp đỡ hoàn thiện code

Chuyển thành function đương nhiên không có vấn đề

Mã:

Function Translate(ByVal text_to_translate As String, ByVal Lang_In As String, ByVal Lang_Out As String) As String
  Dim i As Long
  Dim result_data As String, tmp
  On Error Resume Next
  
  With CreateObject("InternetExplorer.application")
    .Visible = False
    .navigate "http://translate.google.com/#" & Lang_In & "/" & Lang_Out & "/" & text_to_translate

    Do Until .ReadyState = 4: DoEvents: Loop
    Application.Wait (Now + TimeValue("0:00:5"))
    Do Until .ReadyState = 4: DoEvents: Loop
    
    tmp = Split(Replace(.Document.getElementById("result_box").innerHTML, "</SPAN>", ""), "<")
    For i = LBound(tmp) To UBound(tmp)
      result_data = result_data & Right(tmp(i), Len(tmp(i)) - InStr(tmp(i), ">"))
    Next
    Translate = result_data
    .Quit
  End With
End Function

Tuy nhiên, nếu bạn dùng function với dữ liệu lớn thì bảng tính sẽ chậm lắm đấy. Tốt nhất dùng Sub để translate sẽ hay hơn

quyenpv · 10/3/13

Cám ơn anh rất nhiều

ndu96081631

ndu96081631 · 10/3/13

quyenpv đã viết:
Cám ơn anh rất nhiều
ndu96081631

Có lẽ nên sửa lại code thành vầy sẽ hợp lý hơn:

Mã:

Function Translate(ByVal text_to_translate As String, ByVal Lang_In As String, ByVal Lang_Out As String) As String
  Dim i As Long
  Dim result_data As String, tmp
  On Error Resume Next
  [COLOR=#ff0000]If Lang_In = "" Then Lang_In = "auto"[/COLOR]
  With CreateObject("InternetExplorer.application")
    .Visible = False
    .navigate "http://translate.google.com/#" & Lang_In & "/" & Lang_Out & "/" & text_to_translate

    Do Until .ReadyState = 4: DoEvents: Loop
    Application.Wait (Now + TimeValue("0:00:5"))
    Do Until .ReadyState = 4: DoEvents: Loop
    
    tmp = Split(Replace(.Document.getElementById("result_box").innerHTML, "</SPAN>", ""), "<")
    For i = LBound(tmp) To UBound(tmp)
      result_data = result_data & Right(tmp(i), Len(tmp(i)) - InStr(tmp(i), ">"))
    Next
    Translate = result_data
    .Quit
  End With
End Function

Chổ màu đỏ vừa mới thêm vào dùng cho trường hợp auto detect
Ngoài ra xin nói thêm: Nếu bạn dùng Excel phiên bản 2010 trở lên thì trong Excel đã có sẵn chương trình Translate rồi (trong tab Review\Translate)

siwtom · 10/3/13

ndu96081631 đã viết:

Chuyển thành function đương nhiên không có vấn đề

Mã:

Function Translate(ByVal text_to_translate As String, ByVal Lang_In As String, ByVal Lang_Out As String) As String
  Dim i As Long
  Dim result_data As String, tmp
  On Error Resume Next
  
  With CreateObject("InternetExplorer.application")
    .Visible = False
    .navigate "http://translate.google.com/#" & Lang_In & "/" & Lang_Out & "/" & text_to_translate

    Do Until .ReadyState = 4: DoEvents: Loop
    Application.Wait (Now + TimeValue("0:00:5"))
    Do Until .ReadyState = 4: DoEvents: Loop
    
    tmp = Split(Replace(.Document.getElementById("result_box").innerHTML, "</SPAN>", ""), "<")
    For i = LBound(tmp) To UBound(tmp)
      result_data = result_data & Right(tmp(i), Len(tmp(i)) - InStr(tmp(i), ">"))
    Next
    Translate = result_data
    .Quit
  End With
End Function

Tuy nhiên, nếu bạn dùng function với dữ liệu lớn thì bảng tính sẽ chậm lắm đấy. Tốt nhất dùng Sub để translate sẽ hay hơn

Sao, các bạn định dùng hàm trong công thức???

Tất nhiên phải có bảng hướng dẫn người dùng nhập như thế nào. Vd. "vi" là dịch sang tiếng Việt, "sv" là tiếng Thụy Điển. Người dùng làm sao tự biết phải nhập như thế nào.

Ngoài ra trong code nguồn người ta đọc ra code HTML - họ dùng innerHTML - nên sẽ nhận được đại loại như:

PHP:

<SPAN closure_uid_954784532="132">Xin chào,</SPAN> <SPAN class=hps closure_uid_954784532="133">thế nào là bạn</SPAN><SPAN closure_uid_954784532="134">?</SPAN>

rồi lại mất công lọc ra text "Xin chào, thế nào là bạn"

Tôi đề nghị dùng innerText để đọc ra luôn text "Xin chào, thế nào là bạn"
------------
Nếu tôi thì tôi làm như sau - viết trong VBE thì có "dòng nhắc". Có kiểm tra thông số vào.

module:

Mã:

Public Enum lang_index
    Detect
    Afrikaans
    Albanian
    Arabic
    Armenian
    Azerbaijani
    Basque
    Belarusian
    Bengali
    Bulgarian
    Catalan
    Chinese
    Croatian
    Czech
    Danish
    Dutch
    English
    Esperanto
    Estonian
    Filipino
    Finnish
    French
    Galician
    Georgian
    German
    Greek
    Gujarati
    Haitian
    Hebrew
    Hindi
    Hungarian
    Icelandic
    Indonesian
    Irish
    Italian
    Japanese
    Kannada
    Korean
    Latin
    Latvian
    Lithuanian
    Macedonian
    Malay
    Maltese
    Norwegian
    Persian
    Polish
    Portuguese
    Romanian
    Russian
    Serbian
    Slovak
    Slovenian
    Spanish
    Swahili
    Swedish
    Tamil
    Telugu
    Thai
    Turkish
    Ukrainian
    Urdu
    Vietnamese
    Welsh
    Yiddish
End Enum

Function Translate(ByVal text As String, ByVal lang_input As lang_index, ByVal lang_output As lang_index) As String
Dim ie As Object, i As Long
    If lang_input < 0 Or lang_input > 64 Then lang_input = 0
    If lang_output < 1 Then
        lang_output = 1
    ElseIf lang_output > 64 Then
        lang_output = 64
    End If

    ID = Array("auto", "af", "sq", "ar", "hy", "az", "eu", "be", "bn", "bg", "ca", "zh-CN", "hr", "cs", "da", "nl", "en", "eo", "et", "tl", _
            "fi", "fr", "gl", "ka", "de", "el", "gu", "ht", "iw", "hi", "hu", "is", "id", "ga", "it", "ja", "kn", "ko", "la", "lv", "lt", "mk", _
            "ms", "mt", "no", "fa", "pl", "pt", "ro", "ru", "sr", "sk", "sl", "es", "sw", "sv", "ta", "te", "th", "tr", "uk", "ur", "vi", "cy", "yi")

    Set ie = CreateObject("InternetExplorer.application")
    ie.Visible = False
    ie.navigate "http://translate.google.com/#" & ID(lang_input) & "/" & ID(lang_output) & "/" & text

    Do Until ie.ReadyState = 4
        DoEvents
    Loop

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

    Do Until ie.ReadyState = 4
        DoEvents
    Loop

    Translate = ie.Document.getElementById("result_box").innerText

    ie.Quit
End Function

Cách dùng:

text = Translate("Hello, How are you?", English, Vietnamese)

hoặc

text = Translate("Hello, How are you?", Detect, Vietnamese)

hoặc

text = Translate("Hello, How are you?", 0, 62)

ndu96081631 · 10/3/13

siwtom đã viết:
Sao, các bạn định dùng hàm trong công thức???

Tất nhiên phải có bảng hướng dẫn người dùng nhập như thế nào. Vd. "vi" là dịch sang tiếng Việt, "sv" là tiếng Thụy Điển. Người dùng làm sao tự biết phải nhập như thế nào.

Ngoài ra trong code nguồn người ta đọc ra code HTML - họ dùng innerHTML - nên sẽ nhận được đại loại như:

PHP:

Xin chào, thế nào là bạn?

rồi lại mất công lọc ra text "Xin chào, thế nào là bạn"

Tôi đề nghị dùng innerText để đọc ra luôn text "Xin chào, thế nào là bạn"
------------
Nếu tôi thì tôi làm như sau - viết trong VBE thì có "dòng nhắc". Có kiểm tra thông số vào.

Mấy vụ này em không biết đâu anh ơi, em chỉ làm 1 việc vô cùng đơn giản là chuyển Sub thành Function thôi, giải thuật để nguyên (có muốn sửa cũng không rành)

ndu96081631 · 10/3/13

siwtom đã viết:
Cách dùng:

text = Translate("Hello, How are you?", English, Vietnamese)

hoặc

text = Translate("Hello, How are you?", Detect, Vietnamese)

hoặc

text = Translate("Hello, How are you?", 0, 62)

Em vừa test xong: 2 cách màu đỏ không thể dùng được trong trường hợp gõ trực tiếp lên bảng tính anh à (chỉ có thể dùng trong VBA thôi)

quyenpv · 10/3/13

ndu96081631 đã viết:
Mấy vụ này em không biết đâu anh ơi, em chỉ làm 1 việc vô cùng đơn giản là chuyển Sub thành Function thôi, giải thuật để nguyên (có muốn sửa cũng không rành)

Code của bác ndu96081631 sửa lại là OK rồi, cái này dùng tốt trong trường hợp file cần dùng 2 ngôn ngữ.

siwtom · 10/3/13

ndu96081631 đã viết:
Em vừa test xong: 2 cách màu đỏ không thể dùng được trong trường hợp gõ trực tiếp lên bảng tính anh à (chỉ có thể dùng trong VBA thôi)

Thì thế tôi mới viết: Sao, các bạn định dùng hàm trong công thức???

ndu96081631 · 10/3/13

siwtom đã viết:
Thì thế tôi mới viết: Sao, các bạn định dùng hàm trong công thức???

Anh rành Internet Control cho em hỏi chút:
- Tại sao trong code lại cần có 2 vòng lập Do.. Loop?
- Application.Wait để làm gì?
Em test trên máy em: Bỏ bớt 1 vòng lập Do... Loop, bỏ luôn Application.Wait thấy cũng ra kết quả luôn:

Mã:

Function Translate(ByVal text_to_translate As String, ByVal Lang_In As String, ByVal Lang_Out As String) As String
  Dim i As Long
  Dim result_data As String, tmp
  On Error Resume Next
  If Lang_In = "" Then Lang_In = "auto"
  With CreateObject("InternetExplorer.application")
    .Visible = False
    .navigate "http://translate.google.com/#" & Lang_In & "/" & Lang_Out & "/" & text_to_translate
    Do Until .ReadyState = 4: DoEvents: Loop
    result_data = .Document.getElementById("result_box").innerText
    Translate = result_data
    .Quit
  End With
End Function

siwtom · 10/3/13

quyenpv đã viết:
Code của bác ndu96081631 sửa lại là OK rồi, cái này dùng tốt trong trường hợp file cần dùng 2 ngôn ngữ.

Có ai nói là không OK đâu?

Bạn trích:

Mấy vụ này em không biết đâu anh ơi, em chỉ làm 1 việc vô cùng đơn giản là chuyển Sub thành Function thôi, giải thuật để nguyên (có muốn sửa cũng không rành)

nhưng bạn có hiểu chữ "sửa" là nói về cái quái gì đâu. Bạn đâu có hiểu tôi với ndu nói về cái gì.

Mà chuyện dùng mấy ngôn ngữ thì bạn có tiết lộ đâu. Bây giờ bạn chiếu cố nên bạn cho biết là chỉ cần dùng 2 ngôn ngữ?

siwtom · 10/3/13

ndu96081631 đã viết:
Anh rành Internet Control cho em hỏi chút:
- Tại sao trong code lại cần có 2 vòng lập Do.. Loop?
- Application.Wait để làm gì?
Em test trên máy em: Bỏ bớt 1 vòng lập Do... Loop, bỏ luôn Application.Wait thấy cũng ra kết quả luôn:

Mã:

Function Translate(ByVal text_to_translate As String, ByVal Lang_In As String, ByVal Lang_Out As String) As String Dim i As Long Dim result_data As String, tmp On Error Resume Next If Lang_In = "" Then Lang_In = "auto" With CreateObject("InternetExplorer.application") .Visible = False .navigate "http://translate.google.com/#" & Lang_In & "/" & Lang_Out & "/" & text_to_translate Do Until .ReadyState = 4: DoEvents: Loop result_data = .Document.getElementById("result_box").innerText Translate = result_data .Quit End With End Function

Thực ra là mình cứ copy code của "người ta" mà quên không xóa thôi.

Các bước là thế này:

Mã:

With CreateObject("InternetExplorer.application")
    .Visible = False
    .navigate "http://translate.google.com/#" & Lang_In & "/" & Lang_Out & "/" & text_to_translate
    Do Until .ReadyState = 4: DoEvents: Loop
    result_data = .Document.getElementById("result_box").innerText

Nếu ta bỏ "Do Until .ReadyState = 4: DoEvents: Loop" thì sau dòng code .navigate thì dòng code result_data = .Document.getElementById("result_box").innerText được thực hiện ngay. Sẽ sẩy ra tình huống là trang Web chưa load xong thì code đã muốn truy cập tới "nội dung" của nó. Lúc đó kết quả sẽ "không có gì".

Những code sử dụng những con số là những code rất "tối". Các số 2, 3, 4 chả nói lên cái gì cả, chả gợi ý. Mà ai cũng dùng số như thế thì con cháu tương lai sẽ gõ gì vào google để tìm kiếm? Gõ 2, 3, 4?

Nên:

Mã:

Private Const READYSTATE_COMPLETE = 4
...
Do Until .ReadyState = READYSTATE_COMPLETE ...

"Do Until .ReadyState = READYSTATE_COMPLETE: DoEvents: Loop" là cho tới tận khi trang web chưa load xong toàn bộ thì "chờ". Application.Wait cũng là chờ.

Người ta làm quá cẩn thận thôi mà.

quyenpv · 10/3/13

siwtom đã viết:
Có ai nói là không OK đâu?

Bạn trích:

nhưng bạn có hiểu chữ "sửa" là nói về cái quái gì đâu. Bạn đâu có hiểu tôi với ndu nói về cái gì.

Mà chuyện dùng mấy ngôn ngữ thì bạn có tiết lộ đâu. Bây giờ bạn chiếu cố nên bạn cho biết là chỉ cần dùng 2 ngôn ngữ?

Trình độ có hạn không biết các đại ca nói gì xin thứ lỗi

giaosucan · 15/3/13

e có thử dùng các hàm này, nhưng ko hiểu sao kết quả ra trắng hết ???

ndu96081631 · 15/3/13

giaosucan đã viết:
e có thử dùng các hàm này, nhưng ko hiểu sao kết quả ra trắng hết ???

"ra trắng" thì bấm F2 vào cell chứa hàm rồi Enter lần nữa đi

siwtom · 15/3/13

giaosucan đã viết:
e có thử dùng các hàm này, nhưng ko hiểu sao kết quả ra trắng hết ???

Bạn đọc các bài từ #1 tới #12 trong chủ đề sau:

http://www.giaiphapexcel.com/forum/...-đa-ngôn-ngữ-(dựa-vào-Google-Translate)/page2

HeSanbi · 16/3/18

---Để dịch nhanh hơn----
Mình xin góp 1 code này, cũng nhờ tìm hiểu trên Google:

Mã:

Public Function TranslateTwo(strInput As String, strFromLanguageCode As String, strToLanguageCode As String, Optional blnTargetAlphabet As Boolean = True) As String
    Dim strURL As String
    Dim objHTTP As Object
    Dim objHTML As Object
    Dim objDivs As Object, objDiv
    Dim strTranslatedT0 As String
    Dim strTranslatedO1 As String
If strInput = vbNullString Then Exit Function
 
    strURL = "https://translate.google.com/m?hl=" & strFromLanguageCode & _
        "&sl=" & strFromLanguageCode & _
        "&tl=" & strToLanguageCode & _
        "&ie=UTF-8&prev=_m&q=" & strInput

    Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
    objHTTP.Open "GET", strURL, False
    objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
    objHTTP.send ""

    ' create a html document
    Set objHTML = CreateObject("htmlfile")
    With objHTML
        .Open
        .Write objHTTP.responseText
        .Close
    End With

    Set objDivs = objHTML.getElementsByTagName("div")
    For Each objDiv In objDivs
        If objDiv.className = "o1" Then
            strTranslatedO1 = objDiv.innerText
        End If
        If objDiv.className = "t0" Then
            strTranslatedT0 = objDiv.innerText
        End If
    Next objDiv

    If blnTargetAlphabet Then
        TranslateTwo = strTranslatedT0
    Else
        TranslateTwo = strTranslatedO1
    End If

CleanUp:
    Set objHTML = Nothing
    Set objHTTP = Nothing

End Function

Cách dùng:

Thứ nhất:
A1 = hello world
B1 =TranslateTwo(A1,"en","vi")
hoặc B1 =TranslateTwo(A1,"","vi")
Thứ 2:
A1 = 你好 ( ngôn ngữ Tượng hình : Trung Quốc, Nhật, Hàn Quốc, .....)
- trả về kí tự Latinh (để đọc) và dịch
B1 =TranslateTwo(A1,"zh-CN","vi",False)
C1 =TranslateTwo(A1,"zh-CN","vi",True)

Giúp đỡ sửa code vba Translate thành Function! (1 người xem)

Người dùng đang xem chủ đề này

Thu nhặt kiến thức

File đính kèm

Huyền thoại GPE

Thu nhặt kiến thức

Huyền thoại GPE

Thành viên gắn bó

Huyền thoại GPE

Huyền thoại GPE

Thu nhặt kiến thức

Thành viên gắn bó

Huyền thoại GPE

Thành viên gắn bó

Thành viên gắn bó

Thu nhặt kiến thức

Thành viên hoạt động

Huyền thoại GPE

Thành viên gắn bó

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

Đếm ngược thời gian