Dịch thuật và phát hiện ngôn ngữ cho Office và VBA Editor (*Update: 09/08/2019)

HeSanbi

Thành viên tích cực
Tham gia ngày
24 Tháng hai 2013
Bài viết
906
Được thích
681
Điểm
560
*(Cập nhật mới: 09/08/2019)
*Bản cập nhật bao gồm:
1. Hàm mới DetachText
2. Thêm hàm kiểm tra kết nối mạng
3. Thêm hàm GoogleTranslateX dành cho lập trình.
4. 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", "vi")​
Gồm 4 tham số:​
+ Tham số 1 - Chuỗi cần nhập để phát hiện ngôn ngữ​
+ Tham số 2 - Mã ngôn ngữ đích sẽ dịch​
+ Tham số 3 - Trả về chuỗi đã được phiên dịch tới ngôn ngữ đích​
+ Tham số 4 - Trả về mức độ chính xác của việc phát hiện​
Xin lưu ý: Hàm này cần tải module JsonConverter tại: https://github.com/VBA-tools/VBA-JSON

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

Code:
PHP:
' Mở VBA hoặc tổ hợp phím Alt + F11'
'Tạo Module mới và copy code vào module'

#If VBA7 Then
  Private Declare PtrSafe Function InternetGetConnectedState _
                  Lib "wininet.dll" ( _
                    ByRef dwflags As Long, _
                    ByVal dwReserved As Long) As Long
#Else
  Private Declare Function InternetGetConnectedState _
                  Lib "wininet.dll" ( _
                    ByRef dwflags As Long, _
                    ByVal dwReserved As Long) As Long
#End If
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 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$ = "-_")
  If Not HasInternet Then GoogleTranslateX = "No Internet!": Exit Function
  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 ""
      If .Status <> 200 Then Exit Function
      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'
'==========================================='
Function HasInternet() As Boolean
  Dim L&, r&
  r = InternetGetConnectedState(L, 0&)
  HasInternet = (r <= 4 And r <> 0)
End Function

Sub InitCreateObject(Optional DelObject As Boolean)
  If Not oGlb_Html Is Nothing Then Exit Sub
  If Not DelObject Then
    Set oGlb_Html = CreateObject("htmlfile")
    #If Win64 Then
       Set oGlb_Http = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    #Else
      Set oGlb_Http = CreateObject("MSXML2.ServerXMLHTTP")
    #End If
  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
Để Sử dụng Phát hiện ngôn ngữ Hãy tải JsonConvert VBA trước khi copy code dưới đây
tại: https://github.com/VBA-tools/VBA-JSON

PHP:
Function GoogleDetectLang(ByVal strInput$, _
                Optional ByVal FrLangCode$ = "auto", _
                Optional ByVal ToLangCode$ = "vi", _
                Optional ByRef Translate$, _
                Optional ByRef ExactRate$)
  If Not HasInternet Then GoogleDetectLang = "No Internet!": Exit Function
  Dim Str, strURL$, k&, sp$()
  If strInput = vbNullString Then Exit Function
  InitCreateObject
  sp = Split(strInput, vbNewLine)
  For Each Str In sp
    If Trim$(Application.Clean(Str)) <> vbNullString Then
      GoSub trans: k = k + 1
    End If
  Next
Ends: Exit Function
trans:
    strURL = "https://translate.googleapis.com/translate_a/single?client=gtx&sl=" _
            & FrLangCode & "&tl=" & ToLangCode & _
            "&dt=t&q=" & Application.ENCODEURL(Str)
    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 ""
      If .Status <> 200 Then GoTo Ends
      Text = .responseText
    End With
    Dim oJson
    'Vui long tai module JsonConverter.bas tại: https://github.com/VBA-tools/VBA-JSON'
    Set oJson = JsonConverter.ParseJson(Text)
    Translate = Translate & IIf(Translate <> vbNullString, vbNewLine, vbNullString) & oJson(1)(1)(1)
    GoogleDetectLang = GoogleDetectLang & IIf(GoogleDetectLang <> vbNullString, vbNewLine, vbNullString) & oJson(3)
    ExactRate = ExactRate & IIf(ExactRate <> vbNullString, vbNewLine, vbNullString) & oJson(7)
  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]
 
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
906
Được thích
681
Đ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
90
Đượ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
906
Được thích
681
Đ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
906
Được thích
681
Đ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
138
Được thích
78
Đ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
6,915
Được thích
8,105
Đ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
906
Được thích
681
Điểm
560
Cập nhật: 09/08/2019
Thêm hàm Phát hiện ngôn ngữ.
 
Top Bottom