ترجمة حقل تلقائي

[ansary184]

السلام عليكم لدي قاعدة بيانات تلاميذ اريد ترجمة اسم الطالب تلقائي في حقل اخر الي الانجليزية 

[دروب مبرمج]

انشئ مديول جديد و الصق فيه الشفرة التالية

Public Function Translate(strInput As String, strFromSourceLanguage As String, strToTargetLanguage As String) As String
On Error GoTo errorhandle
Dim strURL As String
Dim objHTTP As Object
Dim objHTML As Object
Dim objDivs As Object, objDiv As Object
Dim strTranslated As String

strURL = "https://translate.google.com/m?hl=" & strFromSourceLanguage & _
    "&sl=" & strFromSourceLanguage & _
    "&tl=" & strToTargetLanguage & _
    "&ie=UTF-8&prev=_m&q=" & EncodeQP2(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 ""

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 = "t0" Then
        strTranslated = objDiv.innerText
        Translate = strTranslated
    End If

Next objDiv
Set objHTML = Nothing
Set objHTTP = Nothing
errorhandleexit:
        Exit Function
errorhandle:
        MsgBox Err.Description
        Resume errorhandleexit

End Function

Function EncodeQP2(s As String) As String
    Dim i As Long
    Dim p1 As Long
    Dim p2 As Long
    Dim r As String
    Dim n As Long
    For i = 1 To Len(s)
        n = AscW(Mid(s, i, 1))
        If n < 128 Then
            r = r & "%" & Hex(n)
        ElseIf n < 2048 Then
            p1 = n \ 64
            r = r & "%" & Hex(p1 + 192)
            p2 = n Mod 64
            r = r & "%" & Hex(p2 + 128)
        Else
           
        End If
    Next i
    EncodeQP2 = r
End Function

و في حصل الاستعلام او النموذج او اي مكان ضع التالي

Translate([TextBox1], "auto", "en")

 

[ansary184]

مشكور اخي علي سرعة الاجابة ولكن لم يتم عرض الترجمة 

[Foksh]

أعتقد أنه لابد من وجود اتصال انترنت ، لأن الكود يستدعي سيرفر ترجمة جوجل.

[ansary184]

يوجد اتصال بالانترنت 

[محمد احمد لطفى]

اتفضل ده مثال من أستاذى @دروب مبرمج

 

Replace.accdb

[ansary184]

اشكرم جدا جدا جدا لقد عمل بكفاءة 

[دروب مبرمج]

ضع علامة يساوي قبل الأمر فقط