مساعدة في ايجاد الخطأ في الكود

[ahmed1399]

لسلام عليكم
مرفق لكم مثال جميل جدا منقول قناة ايه سوفت
وذلك لترجمة النصوص في قاعدة البيانات
البرنامج يعمل لكن يوجد مشكلة تتلخص انه عند كتابة اي كلمة والضغط على امر (ترجم) تفتح صفحة قوقل ترجمه وكذلك لا ينسخ الكلمة بعد الترجمة
وتظهر لدي رسالة خطأ
424
object required

Google-Tran.rar

[jjafferr]

وعليكم السلام 🙂

 

لو بحثت في المنتدى ، لوجدت مترجم جميل عمل عليه اخوي حسين @د.كاف يار

 

 

جعفر

[ahmed1399]

شكرا استاذي الكريم 

لكن البرنامج المرفق في المشاركة التي ارفقتها مشكورا لا يعمل

[jjafferr]

رجاء مراجعة مكتباتك ، فانا ذكرت هذا في المشاركة التالية في الرابط اعلاه ، تفضل:

 

في ٥‏/٦‏/٢٠٢١ at 19:50, jjafferr said:

وبسبب طريقة برمجتك ، فنحن محتاجين الى هذه المكتبات فقط 🙂

 

جعفر

[د.كاف يار]

اخي الكريم في البداية قم بإنشاء Module جديد

و من خلال المكتبات 

قم بإضافة المكتبة التالية فقد يختلف رقم الإصدار حسب اصدار الأوفيس لديك

و في Module الصق الكود التالي

Option Explicit
Public as1 As String
Public Function Translate(strInput As String, strFromSourceLanguage As String, strToTargetLanguage As String) As String

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?sl=" & strFromSourceLanguage & "&tl=" & strToTargetLanguage & "&q=" & strInput & "&hl=ar"

Set objHTML = Nothing
Set objHTTP = CreateObject("Msxml2.XMLHTTP.6.0")
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 = "result-container" Then
        strTranslated = objDiv.innerText
        Translate = strTranslated
    End If


Next objDiv


'DoCmd.GoToRecord , , acNext

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

 

و لنأخذ مثال على ذلك لكي نترجم مربع نص من اللغة العربية الى الإنجليزية

Dim FromLanguage, ToLanguage As String
FromLanguage = "auto"   ' الترجمة من أي لغة مختلفة
ToLanguage = "en"   ' الترجمة الى اللغة العربية
[TextBox1] = Translate(EncodeQP2([TextBox1]), FromLanguage, ToLanguage)

مرفق المثال لتطبيق اعلاه

GoogleTran.accdb

[ahmed1399]

شكرا شكرا اساتذي الكبار

نفع الله بكم وبعلكم

[Eng.Qassim]

On 9/1/2021 at 7:02 PM, ahmed1399 said:

لسلام عليكم
مرفق لكم مثال جميل جدا منقول قناة ايه سوفت
وذلك لترجمة النصوص في قاعدة البيانات
البرنامج يعمل لكن يوجد مشكلة تتلخص انه عند كتابة اي كلمة والضغط على امر (ترجم) تفتح صفحة قوقل ترجمه وكذلك لا ينسخ الكلمة بعد الترجمة
وتظهر لدي رسالة خطأ
424
object required

Google-Tran.rar 56.65 kB · 9 downloads

استاذي العزيز احمد ..

شخصيا استمتع جدا باي سؤال يطرح على منتدانا الرائع .. حيث انه يكسبني خبرة ويقدمني خطوة

لكن مالفائدة من وجود مترجم في قاعدة البيانات ... و كوكل وفرت لنا من التسهيلات في ذلك ؟

[ahmed1399]

اهلا اخي الكريم 

اعتذر جدا عن التاخير في الاجابة 😌

انا لدي برنامج شبيه بالدردشة ويعمل على شبكة داخلية لمنشأة تضم موظفين من عدة دول 

واحتاج الترجمة الفورية لتسهيل التخاطب بينهم 

وحقيقة نجحت بكم 

وفق الله الجميع