Dịch thuật và phát hiện ngôn ngữ cho Office và VBA Editor

HeSanbi

Thành viên tích cực
Tham gia ngày
24 Tháng hai 2013
Bài viết
1,174
Được thích
1,050
Điểm
560
Hàm dưới đây sẽ giúp dịch thuật và phát hiện ngôn ngữ cho Office và VBA Editor
Code VBA hoạt động yêu cầu có Internet để dịch thông qua Google Translate​
Dịch ra nhiều thứ tiếng và nhiều thứ tiếng ra tiếng Việt​
Ưu điểm: Khi viết code hoặc copy code tham khảo qua mạng, thường sẽ xuất hiện những thuật ngữ mới, vậy nên cần đến dịch thuật.
Với dữ liệu Excel thì khá nhiều ngôn ngữ nên việc dịch thuật là đương nhiên.

-------------------------------------------------------------------------------------
*(Cập nhật mới: 24/10/201919)
*Bản cập nhật bao gồm: Không sử dụng thư viện JsonConverter cho hàm phát hiện ngôn ngữ
-------------------------------------------------------------------------
1. Dịch
- Điền mã ngôn ngữ Mặc định và mã ngôn ngữ cần dịch


Ví dụ 1: Có 4 tham số: Từ để dịch - Mã ngôn ngữ nguồn - Mã ngôn ngữ đích - Cách đọc (nếu có)(Bỏ trống ->False)
=GoogleTranslate("Hello","en","vi", False)
Kết quả: "Xin chào"
Ví dụ 2: Biến thứ hai để trống thì ngôn ngữ phát hiện và dịch tự động
=GoogleTranslate("xin chào", ,"zh-cn")
Kết quả: "你好"
Biến thứ 3 là ngôn ngữ cần dịch để trống thì mặc định là tiếng Việt
Ví dụ 3: Biến thứ tư là True thì lấy cách đọc của từ đã được dịch (nếu có - thường là chữ tượng hình)
=GoogleTranslate("xin chào", ,"zh-cn", True)
"Nǐ hǎo"
*Lưu ý: Nếu File tạo để sử dụng trên Google Spreadsheet thì không nên điền tham số thứ 4.
=GoogleTranslate("Hello","en","vi")
- Hàm đặc biệt GoogleTranslateX (mới cập nhật):




=GoogleTranslateX("Hello","en","vi", False , True, False, " -_/")
Được thêm 3 tham số sau cùng dựa trên hàm DetachText bao gồm:


+ Tham số 6 - hDetach: Cho phép tách chuỗi liên tục có dấu phân cách hoặc Chữ In hoa, mặc định là False.
+ Tham số 7 - hSpecial: Cho phép thêm dấu cách vào khi gặp ký tự đặc biệt, mặc định là False.
+ Tham số 8 - CharRemove: Nhập các ký tự cần phân cách, mặc định là " -_".

- Hàm DetachText: sẽ tách chuỗi liên tục được ngăn cách bởi ký tự khác dấu " " (dấu cách) , hoặc Âm viết hoa.
Hàm này sẽ giúp dịch các hàm , các comment trong Cửa sổ lập trình VBE.

2. Phát hiện ngôn ngữ :

- Hàm GoogleDetectLang (mới cập nhật):


=GoogleDetectLang("Hello")
+ Tham số - Chuỗi cần nhập để phát hiện ngôn ngữ


3. Dịch nhanh trong lập trình code VBA: (cập nhật sau)


-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
Chúc các bạn thành công trong công việc của mình!


Tag: dịch tiếng Việt, dịch tiếng Anh, dịch tiếng Anh sang tiếng Việt, phát hiện ngôn ngữ , dịch đa ngôn ngữ, phiên ngữ tiếng Việt,phiên ngữ đa thứ tiếng, hàm dịch, hàm phiên ngữ, dịch nhiều thứ tiếng, dịch excel, excel dịch
'----------------
JavaScript:
' Mở VBA hoặc tổ hợp phím Alt + F11'
'Tạo Module mới và copy code vào module'

Public oGlb_Html As Object, oGlb_Http As Object

Function GoogleTranslate$(ByVal strInput$, _
                Optional ByVal FrLangCode$, _
                Optional ByVal ToLangCode$ = "vi", _
                Optional ByVal IsHieroglyphs As Boolean)
  If Not HasInternet Then GoogleTranslate = "No Internet!": Exit Function
  Dim Str, strURL$, k&, sp$(), o1(), t0()
  If strInput = vbNullString Then Exit Function
  InitCreateObject
  sp = Split(strInput, vbNewLine)
  For Each Str In sp
    If Trim$(Application.Clean(Str)) <> vbNullString Then
      ReDim Preserve o1(k)
      ReDim Preserve t0(k)
      GoSub trans: k = k + 1
    End If
  Next
  If (IsHieroglyphs) Then
    GoogleTranslate = Join(o1, vbNewLine)
  Else
    GoogleTranslate = Join(t0, vbNewLine)
  End If
CleanUp: Exit Function
trans:
    strURL = "https://translate.google.com/m?hl=" & FrLangCode & _
      "&sl=" & FrLangCode & _
      "&tl=" & ToLangCode & _
      "&ie=UTF-8&prev=_m&q=" & Str
    Dim Text$
    With oGlb_Http
      .Open "GET", strURL, False
      .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
      .Send ""
      If .Status <> 200 Then Exit Function
      Text = .responseText
    End With
    With oGlb_Html: .Open: .Write Text: .Close: End With
    Dim oDiv
    For Each oDiv In oGlb_Html.getElementsByTagName("div")
      If oDiv.className = "o1" Then o1(k) = oDiv.innerText
      If oDiv.className = "t0" Then t0(k) = oDiv.innerText: Exit For
    Next oDiv
    Set oDiv = Nothing
  Return
End Function

Function GoogleDetectLang(ByVal strInput$)
  Dim strURL$
  InitCreateObject
  If strInput = vbNullString Then Exit Function
   GoSub trans
Ends: Exit Function
trans:
    strURL = "https://translate.googleapis.com/translate_a/single?client=gtx&sl=auto" _
            & "&dt=t&q=" & Application.EncodeURL(Left(strInput, 50))
    Dim Text$
    With oGlb_Http
      .Open "GET", strURL, False
      .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
      .setRequestHeader "Content-Type", "applicaton/X-www-form-urlencoded"
      .Send ""
      Text = VBA.Replace(.responseText, VBA.Chr(10), "")
    End With
    GoogleDetectLang = VBA.Replace(VBA.Replace(VBA.Split(VBA.Right(Text, VBA.Len(Text) - VBA.InStr(Text, "],[") - 2), "],")(0), """", ""), "]", "")
  Return
End Function

Function GoogleTranslateX$(ByVal strInput$, _
                Optional ByVal FrLangCode$, _
                Optional ByVal ToLangCode$ = "vi", _
                Optional ByVal IsHieroglyphs As Boolean, _
                Optional ByVal hDetach As Boolean, _
                Optional ByVal hSpecial As Boolean, _
                Optional ByVal CharRemove$ = "-_")

  Dim Str, strURL$, k&, sp$(), o1(), t0()
  If strInput = vbNullString Then Exit Function
  InitCreateObject
  If hDetach Then strInput = DetachText(strInput, hSpecial, CharRemove)
  sp = Split(strInput, vbNewLine)
  For Each Str In sp
    If Trim$(Application.Clean(Str)) <> vbNullString Then
      ReDim Preserve o1(k)
      ReDim Preserve t0(k)
      GoSub trans: k = k + 1
    End If
  Next
  If (IsHieroglyphs) Then
    GoogleTranslateX = Join(o1, vbNewLine)
  Else
    GoogleTranslateX = Join(t0, vbNewLine)
  End If
CleanUp: Exit Function
trans:
    strURL = "https://translate.google.com/m?hl=" & FrLangCode & _
      "&sl=" & FrLangCode & _
      "&tl=" & ToLangCode & _
      "&ie=UTF-8&prev=_m&q=" & Str
    Dim Text$
    With oGlb_Http
      .Open "GET", strURL, False
      .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
      .Send ""
      Text = .responseText
      If Text = vbNullString Then Return
    End With
    With oGlb_Html: .Open: .Write Text: .Close: End With
    Dim oDiv

    For Each oDiv In oGlb_Html.getElementsByTagName("div")
      If oDiv.className = "o1" Then o1(k) = oDiv.innerText
      If oDiv.className = "t0" Then t0(k) = oDiv.innerText: Exit For
    Next oDiv
    Set oDiv = Nothing
  Return
End Function


'Bảng mã ngôn ngữ:'
Function LanguageId$(strLang$)
    Dim strLangIds$(), arrLangIds, I%
    arrLangIds = Array("Afrikaans - af", "Albanian - sq", "Arabic - ar", "Armenian - hy", "Azerbaijani - az", _
                      "Basque - eu", "Belarusian - be", "Bengali - bn", "Bulgarian - bg", "Catalan - ca", "Chinese - zh-CN", _
                      "Croatian - hr", "Czech - cs", "Danish - da", "Dutch - nl", "English - en", "Esperanto - eo", "Estonian - et", _
                      "Filipino - tl", "Finnish - fi", "French - fr", "Galician - gl", "Georgian - ka", "German - de", _
                      "Greek - el", "Gujarati - gu", "Haitian Creole - ht", "Hebrew - iw", "Hindi - hi", "Hungarian - hu", _
                      "Icelandic - is", "Indonesian - id", "Irish - ga", "Italian - it", "Japanese - ja", "Kannada - kn", _
                      "Korean - ko", "Latin - la", "Latvian - lv", "Lithuanian - lt", "Macedonian - mk", "Malay - ms", _
                      "Maltese - mt", "Norwegian - no", "Persian - fa", "Polish - pl", "Portuguese - pt", "Romanian - ro", _
                      "Russian - ru", "Serbian - sr", "Slovak - sk", "Slovenian - sl", "Spanish - es", "Swahili - sw", _
                      "Swedish - sv", "Tamil - ta", "Telugu - te", "Thai - th", _
                      "Turkish - tr", "Ukrainian - uk", "Urdu - ur", "Vietnamese - vi", "Welsh - cy", "Yiddish - yi")
    For I = LBound(arrLangIds) To UBound(arrLangIds)
      If InStr(1, arrLangIds(I), strLang, vbTextCompare) Then
        LanguageId = Split(arrLangIds(I), " - ")(1)
        Exit For
      End If
    Next I
    LanguageId = strLang
End Function

'==========================================='
'Check Internet'
'==========================================='

Sub InitCreateObject(Optional DelObject As Boolean)
  If Not oGlb_Html Is Nothing Then Exit Sub
  If Not DelObject Then
    Set oGlb_Html = CreateObject("htmlfile")
    Set oGlb_Http = CreateObject("WinHttp.WinHttpRequest.5.1")
  Else
    Set oGlb_Html = Nothing
    Set oGlb_Http = Nothing
  End If
End Sub

Function DetachText(Text$, Optional ByVal sSpecial As Boolean, _
                          Optional ByVal CharRemove$ = "-_")
  CharRemove = CharRemove & " "
  Dim LText&, I&, k&, ISng$, rStr$, Arr()
  Dim Tmp$, LTmp$, UTmp$, U$, L$
  Dim FullU As Boolean, Added As Boolean, Num As Boolean
  U = UCase$(Text): L = LCase$(Text)
  If U = L Then DetachText = Text: Exit Function
  FullU = (Text = U): LText = Len(Text): rStr = Mid$(Text, 1, 1)
  For I = 2 To LText
    ISng = Mid$(Text, I, 1)
    If CharRemove Like "*" & ISng & "*" Then
      GoSub Assign: Num = False
    Else
      LTmp = LCase$(ISng): UTmp = UCase$(ISng)
      If LTmp <> UTmp Then
        If Not FullU Then
          If LTmp = ISng Then
            If Num Then GoSub Assign
            Added = False
          Else
            Added = False: GoSub Assign
          End If
        Else
          Added = False
        End If
        rStr = rStr & ISng: Num = False
      ElseIf IsNumeric(ISng) Then
        If Not Num Then GoSub Assign
        rStr = rStr & ISng: Num = True
      Else
        If Num Then GoSub Assign
        rStr = rStr & IIf(sSpecial, " ", "") & ISng
        Num = False
      End If
    End If
  Next
  Added = False: GoSub Assign: DetachText = Join(Arr, " ")
  Erase Arr
Exit Function
AddArr:
  k = k + 1: ReDim Preserve Arr(1 To k)
  Arr(k) = rStr: rStr = vbNullString
Return
Assign:
  If Not Added Then GoSub AddArr: Added = True
Return
End Function
-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
Chúc các bạn thành công trong công việc của mình!


Tag: dịch tiếng Việt, dịch tiếng Anh, dịch tiếng Anh sang tiếng Việt, phát hiện ngôn ngữ , dịch đa ngôn ngữ, phiên ngữ tiếng Việt,phiên ngữ đa thứ tiếng, hàm dịch, hàm phiên ngữ, dịch nhiều thứ tiếng, dịch excel, excel dịch[/CODE]
 
Chỉnh sửa lần cuối bởi điều hành viên:

HeSanbi

Thành viên tích cực
Tham gia ngày
24 Tháng hai 2013
Bài viết
1,174
Được thích
1,050
Điểm
560
.
 
Lần chỉnh sửa cuối:

vanvan9697

Thành viên chính thức
Tham gia ngày
11 Tháng năm 2012
Bài viết
94
Được thích
5
Điểm
370
Cho mình hỏi bạn 2 đoạn code này nhằm mục đích gì vậy
Mã:
Function ConvertToGet(val As String)
    val = Replace(val, " ", "+")
    val = Replace(val, vbNewLine, "+")
    val = Replace(val, "(", "%28")
    val = Replace(val, ")", "%29")
    ConvertToGet = val
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Clean(val As String)
    val = Replace(val, "&quot;", """")
    val = Replace(val, "%2C", ",")
    val = Replace(val, "&#39;", "'")
    Clean = val
End Function
 

HeSanbi

Thành viên tích cực
Tham gia ngày
24 Tháng hai 2013
Bài viết
1,174
Được thích
1,050
Điểm
560
Cập nhật:
*(Update: 19/05/2019 - GMT+7)
 
Lần chỉnh sửa cuối:

HeSanbi

Thành viên tích cực
Tham gia ngày
24 Tháng hai 2013
Bài viết
1,174
Được thích
1,050
Điểm
560
Cập nhật: 08/08/2019

Cập nhật thêm một số đoạn code và thêm hàm nâng cao.

- Hàm đặc biệt GoogleTranslateX (mới cập nhật) kết hợp hàm DetachText:

=GoogleTranslateX("Hello","en","vi", False , True, False, " -_/")

Được thêm 3 đối số sau cùng dựa trên hàm mới (DetachText) bao gồm:
+ Đối số thứ 6 - hDetach: Cho phép tách chuỗi có dấu phân cách, mặc định là False.
+ Đối số thứ 7 - hSpecial: Cho phép thêm dấu cách vào chuỗi khi gặp ký tự đặc biệt, mặc định là False.
+ Đối số thứ 8 - CharRemove: Nhập các ký tự cần phân cách, mặc định là " -_".


- Hàm DetachText: sẽ tách chuỗi liên tục được ngăn cách bởi ký tự khác dấu " " (dấu cách), hoặc Âm viết hoa.
Hàm này sẽ giúp dịch các hàm , các comment trong Cửa sổ lập trình VBE.
 
Lần chỉnh sửa cuối:

gttrongvn

Thành viên hoạt động
Tham gia ngày
20 Tháng sáu 2011
Bài viết
141
Được thích
81
Điểm
380
anh @HeSanbi có thể giúp mình hàm hiển thị thêm kết quả phiên âm như hình bên dưới được không, nhiều khi mình muốn tìm nghĩa với học cách phát âm cho đúng hay vào google dịch để tìm, nếu hiển thị được cách phiên âm dựa trên hàm của anh nữa thì tiện quá, cảm ơn anh.
 

File đính kèm

VetMini

Gian hùng bàn phiếm (thành viên trôi nước)
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
7,708
Được thích
9,050
Điểm
560
anh @HeSanbi có thể giúp mình hàm hiển thị thêm kết quả phiên âm như hình bên dưới được không, nhiều khi mình muốn tìm nghĩa với học cách phát âm cho đúng hay vào google dịch để tìm, nếu hiển thị được cách phiên âm dựa trên hàm của anh nữa thì tiện quá, cảm ơn anh.
Khi nào bạn tìm được cách hiển thị phiên âm thì phiên âm giùm tôi từ "Ediot" luôn, cảm ơn bạn.

222541
 

HeSanbi

Thành viên tích cực
Tham gia ngày
24 Tháng hai 2013
Bài viết
1,174
Được thích
1,050
Điểm
560
Cập nhật: 09/08/2019
Thêm hàm Phát hiện ngôn ngữ.
 

HeSanbi

Thành viên tích cực
Tham gia ngày
24 Tháng hai 2013
Bài viết
1,174
Được thích
1,050
Điểm
560
*(Cập nhật mới: 24/10/2019)
*Bản cập nhật bao gồm: Không sử dụng thư viện JsonConverter cho hàm phát hiện ngôn ngữ
--------------------------------------------------------------------------------------

Hàm dưới đây sẽ giúp dịch một ngôn ngữ có hỗ trợ sang một ngôn ngữ.
Code VBA hoạt động yêu cầu có Internet để dịch thông qua Google Translate
Dịch ra nhiều thứ tiếng và nhiều thứ tiếng ra tiếng Việt
----------------------------------------------------------
Ưu điểm: Khi viết code hoặc copy code tham khảo qua mạng, thường sẽ xuất hiện những thuật ngữ mới, vậy nên cần đến dịch thuật.
Với dữ liệu Excel thì khá nhiều ngôn ngữ nên việc dịch thuật là đương nhiên.

-------------------------------------------------------------------------
1. Dịch
- Điền mã ngôn ngữ Mặc định và mã ngôn ngữ cần dịch


Ví dụ 1: Có 4 tham số: Từ để dịch - Mã ngôn ngữ nguồn - Mã ngôn ngữ đích - Cách đọc (nếu có)(Bỏ trống ->False)
=GoogleTranslate("Hello","en","vi", False)
Kết quả: "Xin chào"
Ví dụ 2: Biến thứ hai để trống thì ngôn ngữ phát hiện và dịch tự động
=GoogleTranslate("xin chào", ,"zh-cn")
Kết quả: "你好"
Biến thứ 3 là ngôn ngữ cần dịch để trống thì mặc định là tiếng Việt
Ví dụ 3: Biến thứ tư là True thì lấy cách đọc của từ đã được dịch (nếu có - thường là chữ tượng hình)
=GoogleTranslate("xin chào", ,"zh-cn", True)
"Nǐ hǎo"
*Lưu ý: Nếu File tạo để sử dụng trên Google Spreadsheet thì không nên điền tham số thứ 4.
=GoogleTranslate("Hello","en","vi")
- Hàm đặc biệt GoogleTranslateX (mới cập nhật):




=GoogleTranslateX("Hello","en","vi", False , True, False, " -_/")
Được thêm 3 tham số sau cùng dựa trên hàm DetachText bao gồm:


+ Tham số 6 - hDetach: Cho phép tách chuỗi liên tục có dấu phân cách hoặc Chữ In hoa, mặc định là False.
+ Tham số 7 - hSpecial: Cho phép thêm dấu cách vào khi gặp ký tự đặc biệt, mặc định là False.
+ Tham số 8 - CharRemove: Nhập các ký tự cần phân cách, mặc định là " -_".

- Hàm DetachText: sẽ tách chuỗi liên tục được ngăn cách bởi ký tự khác dấu " " (dấu cách) , hoặc Âm viết hoa.
Hàm này sẽ giúp dịch các hàm , các comment trong Cửa sổ lập trình VBE.

2. Phát hiện ngôn ngữ :

- Hàm GoogleDetectLang (mới cập nhật):


=GoogleDetectLang("Hello")
+ Tham số - Chuỗi cần nhập để phát hiện ngôn ngữ


3. Dịch nhanh trong lập trình code VBA: (cập nhật sau)


-----------------------------------------------------------------------------
-----------------------------------------------------------------------------
Chúc các bạn thành công trong công việc của mình!


Tag: dịch tiếng Việt, dịch tiếng Anh, dịch tiếng Anh sang tiếng Việt, phát hiện ngôn ngữ , dịch đa ngôn ngữ, phiên ngữ tiếng Việt,phiên ngữ đa thứ tiếng, hàm dịch, hàm phiên ngữ, dịch nhiều thứ tiếng, dịch excel, excel dịch
'----------------
JavaScript:
' Mở VBA hoặc tổ hợp phím Alt + F11'
'Tạo Module mới và copy code vào module'

Public oGlb_Html As Object, oGlb_Http As Object

Function GoogleTranslate$(ByVal strInput$, _
                Optional ByVal FrLangCode$, _
                Optional ByVal ToLangCode$ = "vi", _
                Optional ByVal IsHieroglyphs As Boolean)
  Dim Str, strURL$, k&, sp$(), o1(), t0()
  If strInput = vbNullString Then Exit Function
  InitCreateObject
  sp = Split(strInput, vbNewLine)
  For Each Str In sp
    If Trim$(Application.Clean(Str)) <> vbNullString Then
      ReDim Preserve o1(k)
      ReDim Preserve t0(k)
      GoSub trans: k = k + 1
    End If
  Next
  If (IsHieroglyphs) Then
    GoogleTranslate = Join(o1, vbNewLine)
  Else
    GoogleTranslate = Join(t0, vbNewLine)
  End If
CleanUp: Exit Function
trans:
    strURL = "https://translate.google.com/m?hl=" & FrLangCode & _
      "&sl=" & FrLangCode & _
      "&tl=" & ToLangCode & _
      "&ie=UTF-8&prev=_m&q=" & Str
    Dim Text$
    With oGlb_Http
      .Open "GET", strURL, False
      .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
      .Send ""
      If .Status <> 200 Then Exit Function
      Text = .responseText
    End With
    With oGlb_Html: .Open: .Write Text: .Close: End With
    Dim oDiv
    For Each oDiv In oGlb_Html.getElementsByTagName("div")
      If oDiv.className = "o1" Then o1(k) = oDiv.innerText
      If oDiv.className = "t0" Then t0(k) = oDiv.innerText: Exit For
    Next oDiv
    Set oDiv = Nothing
  Return
End Function

Function GoogleDetectLang(ByVal strInput$)
  Dim strURL$
  InitCreateObject
  If strInput = vbNullString Then Exit Function
   GoSub trans
Ends: Exit Function
trans:
    strURL = "https://translate.googleapis.com/translate_a/single?client=gtx&sl=auto" _
            & "&dt=t&q=" & Application.EncodeURL(Left(strInput, 50))
    Dim Text$
    With oGlb_Http
      .Open "GET", strURL, False
      .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
      .setRequestHeader "Content-Type", "applicaton/X-www-form-urlencoded"
      .Send ""
      Text = VBA.Replace(.responseText, VBA.Chr(10), "")
    End With
    GoogleDetectLang = VBA.Replace(VBA.Replace(VBA.Split(VBA.Right(Text, VBA.Len(Text) - VBA.InStr(Text, "],[") - 2), "],")(0), """", ""), "]", "")
  Return
End Function

Function GoogleTranslateX$(ByVal strInput$, _
                Optional ByVal FrLangCode$, _
                Optional ByVal ToLangCode$ = "vi", _
                Optional ByVal IsHieroglyphs As Boolean, _
                Optional ByVal hDetach As Boolean, _
                Optional ByVal hSpecial As Boolean, _
                Optional ByVal CharRemove$ = "-_")

  Dim Str, strURL$, k&, sp$(), o1(), t0()
  If strInput = vbNullString Then Exit Function
  InitCreateObject
  If hDetach Then strInput = DetachText(strInput, hSpecial, CharRemove)
  sp = Split(strInput, vbNewLine)
  For Each Str In sp
    If Trim$(Application.Clean(Str)) <> vbNullString Then
      ReDim Preserve o1(k)
      ReDim Preserve t0(k)
      GoSub trans: k = k + 1
    End If
  Next
  If (IsHieroglyphs) Then
    GoogleTranslateX = Join(o1, vbNewLine)
  Else
    GoogleTranslateX = Join(t0, vbNewLine)
  End If
CleanUp: Exit Function
trans:
    strURL = "https://translate.google.com/m?hl=" & FrLangCode & _
      "&sl=" & FrLangCode & _
      "&tl=" & ToLangCode & _
      "&ie=UTF-8&prev=_m&q=" & Str
    Dim Text$
    With oGlb_Http
      .Open "GET", strURL, False
      .setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
      .Send ""
      Text = .responseText
      If Text = vbNullString Then Return
    End With
    With oGlb_Html: .Open: .Write Text: .Close: End With
    Dim oDiv

    For Each oDiv In oGlb_Html.getElementsByTagName("div")
      If oDiv.className = "o1" Then o1(k) = oDiv.innerText
      If oDiv.className = "t0" Then t0(k) = oDiv.innerText: Exit For
    Next oDiv
    Set oDiv = Nothing
  Return
End Function


'Bảng mã ngôn ngữ:'
Function LanguageId$(strLang$)
    Dim strLangIds$(), arrLangIds, I%
    arrLangIds = Array("Afrikaans - af", "Albanian - sq", "Arabic - ar", "Armenian - hy", "Azerbaijani - az", _
                      "Basque - eu", "Belarusian - be", "Bengali - bn", "Bulgarian - bg", "Catalan - ca", "Chinese - zh-CN", _
                      "Croatian - hr", "Czech - cs", "Danish - da", "Dutch - nl", "English - en", "Esperanto - eo", "Estonian - et", _
                      "Filipino - tl", "Finnish - fi", "French - fr", "Galician - gl", "Georgian - ka", "German - de", _
                      "Greek - el", "Gujarati - gu", "Haitian Creole - ht", "Hebrew - iw", "Hindi - hi", "Hungarian - hu", _
                      "Icelandic - is", "Indonesian - id", "Irish - ga", "Italian - it", "Japanese - ja", "Kannada - kn", _
                      "Korean - ko", "Latin - la", "Latvian - lv", "Lithuanian - lt", "Macedonian - mk", "Malay - ms", _
                      "Maltese - mt", "Norwegian - no", "Persian - fa", "Polish - pl", "Portuguese - pt", "Romanian - ro", _
                      "Russian - ru", "Serbian - sr", "Slovak - sk", "Slovenian - sl", "Spanish - es", "Swahili - sw", _
                      "Swedish - sv", "Tamil - ta", "Telugu - te", "Thai - th", _
                      "Turkish - tr", "Ukrainian - uk", "Urdu - ur", "Vietnamese - vi", "Welsh - cy", "Yiddish - yi")
    For I = LBound(arrLangIds) To UBound(arrLangIds)
      If InStr(1, arrLangIds(I), strLang, vbTextCompare) Then
        LanguageId = Split(arrLangIds(I), " - ")(1)
        Exit For
      End If
    Next I
    LanguageId = strLang
End Function

'==========================================='
'Check Internet'
'==========================================='

Sub InitCreateObject(Optional DelObject As Boolean)
  If Not oGlb_Html Is Nothing Then Exit Sub
  If Not DelObject Then
    Set oGlb_Html = CreateObject("htmlfile")
    Set oGlb_Http = CreateObject("WinHttp.WinHttpRequest.5.1")
  Else
    Set oGlb_Html = Nothing
    Set oGlb_Http = Nothing
  End If
End Sub

Function DetachText(Text$, Optional ByVal sSpecial As Boolean, _
                          Optional ByVal CharRemove$ = "-_")
  CharRemove = CharRemove & " "
  Dim LText&, I&, k&, ISng$, rStr$, Arr()
  Dim Tmp$, LTmp$, UTmp$, U$, L$
  Dim FullU As Boolean, Added As Boolean, Num As Boolean
  U = UCase$(Text): L = LCase$(Text)
  If U = L Then DetachText = Text: Exit Function
  FullU = (Text = U): LText = Len(Text): rStr = Mid$(Text, 1, 1)
  For I = 2 To LText
    ISng = Mid$(Text, I, 1)
    If CharRemove Like "*" & ISng & "*" Then
      GoSub Assign: Num = False
    Else
      LTmp = LCase$(ISng): UTmp = UCase$(ISng)
      If LTmp <> UTmp Then
        If Not FullU Then
          If LTmp = ISng Then
            If Num Then GoSub Assign
            Added = False
          Else
            Added = False: GoSub Assign
          End If
        Else
          Added = False
        End If
        rStr = rStr & ISng: Num = False
      ElseIf IsNumeric(ISng) Then
        If Not Num Then GoSub Assign
        rStr = rStr & ISng: Num = True
      Else
        If Num Then GoSub Assign
        rStr = rStr & IIf(sSpecial, " ", "") & ISng
        Num = False
      End If
    End If
  Next
  Added = False: GoSub Assign: DetachText = Join(Arr, " ")
  Erase Arr
Exit Function
AddArr:
  k = k + 1: ReDim Preserve Arr(1 To k)
  Arr(k) = rStr: rStr = vbNullString
Return
Assign:
  If Not Added Then GoSub AddArr: Added = True
Return
End Function
 
Lần chỉnh sửa cuối:

KhanhChi29

Thành viên chính thức
Tham gia ngày
27 Tháng chín 2014
Bài viết
66
Được thích
16
Điểm
370
Tuổi
31
Nơi ở
HaNoi
Em có sử dụng nhưng cho kết quả No Internet!
Mặc dù vẫn vào GPE được
Code chạy với trình duyệt nào vậy anh?
1578538348759.png
 

HeSanbi

Thành viên tích cực
Tham gia ngày
24 Tháng hai 2013
Bài viết
1,174
Được thích
1,050
Điểm
560
Em có sử dụng nhưng cho kết quả No Internet!
Mặc dù vẫn vào GPE được
Code chạy với trình duyệt nào vậy anh?
Bạn xóa dòng code này đi:
If Not HasInternet Then GoogleTranslate = "No Internet!": Exit Function

Hàm dịch gặp một vấn đề nhỏ cần được cải tiến thêm, và sẽ cập nhật trong thời gian sớm nhất.
 
Top Bottom