اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

كيف اجعل برنامجي بجميع لغات العالم


د.كاف يار
إذهب إلى أفضل إجابة Solved by محمد أبوعبدالله,

الردود الموصى بها

احبتي حتى لا أطيل في الشرح و  بدون مقدمات 

قصتي تتضح من عنواني و نبدء الآن ...

انشئ Module جديد و اضف الكود التالي

Option Explicit
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?hl=" & strFromSourceLanguage & _
    "&sl=" & strFromSourceLanguage & _
    "&tl=" & strToTargetLanguage & _
    "&ie=UTF-8&prev=_m&q=" & strInput
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP") 'late binding
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
End Function

 

ثم يمكن تجربة هذه الشفرة الخاصة بتغيير لغة العرض بالطريقة التالية

MsgBox Translate("اهلا و سهلا", "ar", "en")

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

و دمتم في رعاية الله و حفظه ... .

Data.mdb

  • Like 6
  • Thanks 3
رابط هذا التعليق
شارك

ولا اروع

سؤال لو سمحت دكتور هل بالامكان اضافة لغات اضافية

 

بعد مراجعة الرابط الكود ياخذ الترجمة من google مباشرة شكرا دكتور 

 

تم تعديل بواسطه ازهر عبد العزيز
رابط هذا التعليق
شارك

جزاك الله خيراً د.كاف🌹

هل يتطلب وجود انترنت علي الجهاز؟

تحياتي

 

تم تعديل بواسطه محمد سلامة
رابط هذا التعليق
شارك

22 دقائق مضت, ازهر عبد العزيز said:

ولا اروع

سؤال لو سمحت دكتور هل بالامكان اضافة لغات اضافية

 

بعد مراجعة الرابط الكود ياخذ الترجمة من google مباشرة شكرا دكتور 

 

نعم تستطيع اضافة لغات اخرى فقط في اللغة المقابلة ضع رمز اللغة مثلا عربي ar انجلش en و هكذا .... ابحث عن رموز اللغات

 

14 دقائق مضت, محمد سلامة said:

جزاك الله خيراً د.كاف🌹

هل يتطلب وجود انترنت علي الجهاز؟

تحياتي

 

نعم يتطلب وجود انترنت

  • Like 2
رابط هذا التعليق
شارك

  • أفضل إجابة

جزاك الله خيرا استاذنا الفاضل

10 ساعات مضت, ازهر عبد العزيز said:

دكتور لو سمحت هل بالامكان اضافة رسالة تحذيرة قي حال عدم توفر الانترنت الى الكود 

من بعد اذن استاذي خسين

تفضل اخي الكريم

Option Compare Database
Option Explicit
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef dwflags As Long, ByVal dwReserved As Long) As Long

Private Sub أمر0_Click()

    If InternetGetConnectedState(0&, 0&) Then
        labal1.Caption = Translate(labal1.Caption, "ar", "en")
        labal2.Caption = Translate(labal2.Caption, "ar", "en")
        labal13.Caption = Translate(labal13.Caption, "ar", "en")
        Me.أمر19.Visible = True
    Else
        MsgBox "تأكد من اتصالك بالانترنت"
    End If

End Sub


Private Sub أمر19_Click()
    If InternetGetConnectedState(0&, 0&) Then
        labal1.Caption = Translate(labal1.Caption, "en", "ar")
        labal2.Caption = Translate(labal2.Caption, "en", "ar")
        labal13.Caption = Translate(labal13.Caption, "en", "ar")
    Else
        MsgBox "تأكد من اتصالك بالانترنت"
    End If
End Sub

تحياتي

  • Like 4
رابط هذا التعليق
شارك

10 ساعات مضت, محمد أبوعبدالله said:

جزاك الله خيرا استاذنا الفاضل

من بعد اذن استاذي خسين

تفضل اخي الكريم


Option Compare Database
Option Explicit
Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef dwflags As Long, ByVal dwReserved As Long) As Long

Private Sub أمر0_Click()

    If InternetGetConnectedState(0&, 0&) Then
        labal1.Caption = Translate(labal1.Caption, "ar", "en")
        labal2.Caption = Translate(labal2.Caption, "ar", "en")
        labal13.Caption = Translate(labal13.Caption, "ar", "en")
        Me.أمر19.Visible = True
    Else
        MsgBox "تأكد من اتصالك بالانترنت"
    End If

End Sub


Private Sub أمر19_Click()
    If InternetGetConnectedState(0&, 0&) Then
        labal1.Caption = Translate(labal1.Caption, "en", "ar")
        labal2.Caption = Translate(labal2.Caption, "en", "ar")
        labal13.Caption = Translate(labal13.Caption, "en", "ar")
    Else
        MsgBox "تأكد من اتصالك بالانترنت"
    End If
End Sub

تحياتي

ماشاء الله اضافة ممتازة و اشكرك على الرد 

رابط هذا التعليق
شارك

د.كاف يار

استاذنا الكريم بارك الله فيك على مجهودك الكريم

نعم تم تشغيل معي بدون غلطه 100%

ولكن في التقرير في حدث عن الفتح حاولت اخلي يترجم ما داخل النص ولكني عجزت

وستخدمت هذا الكود

Private Sub Report_Open(Cancel As Integer)
On Error Resume Next
Items_NameAdd_Exch.Text = Translate(Items_NameAdd_Exch.Text, "ar", "en")
End Sub

ولكنه تفشل معي هل الترجمه تنص فقط على الليبل فقط ولا تنطبق على ماهو داخل النص

شكرا لكم

رابط هذا التعليق
شارك

10 ساعات مضت, محمد حمزه said:

د.كاف يار

استاذنا الكريم بارك الله فيك على مجهودك الكريم

نعم تم تشغيل معي بدون غلطه 100%

ولكن في التقرير في حدث عن الفتح حاولت اخلي يترجم ما داخل النص ولكني عجزت

وستخدمت هذا الكود


Private Sub Report_Open(Cancel As Integer)
On Error Resume Next
Items_NameAdd_Exch.Text = Translate(Items_NameAdd_Exch.Text, "ar", "en")
End Sub

ولكنه تفشل معي هل الترجمه تنص فقط على الليبل فقط ولا تنطبق على ماهو داخل النص

شكرا لكم

تفضل هذا التعديل اخي الكريم

Data.mdb

  • Like 2
  • Thanks 1
رابط هذا التعليق
شارك

1 ساعه مضت, Ali Mohamed Ali said:

أحسنت استاذ حسين عمل ممتاز بارك الله فيك وزادك الله من فضله

العفو اخي الكريم الأجمل هو مرورك العطر و الجميل شكرا لك

=============================================

الاخوة الأعزاء تم اضافة اللغات المعتمدة في Google

تجدون النسخة المعدلة في المرفقات

translate_language.accdb

تم تعديل بواسطه د.كاف يار
  • Thanks 2
رابط هذا التعليق
شارك

18 دقائق مضت, د.كاف يار said:

الاخوة الأعزاء تم اضافة اللغات المعتمدة في Google

تجدون النسخة المعدلة في المرفقات

ابداع ليس له حدود 

هل بالامكان اضافة الرسالة التحذيرة بعدم وجود الانترنت للاستاذ محمد فلم استطع اضافتها واكم منا جزيل الشكر والعرفان 

رابط هذا التعليق
شارك

منذ ساعه, ازهر عبد العزيز said:

ابداع ليس له حدود 

هل بالامكان اضافة الرسالة التحذيرة بعدم وجود الانترنت للاستاذ محمد فلم استطع اضافتها واكم منا جزيل الشكر والعرفان 

 

 

العفو اخي الكريم يشرفني مرورك و يشرفني أنه نال اعجابك

تفضل طلبك

translate_language.accdb

  • Like 3
رابط هذا التعليق
شارك

2 دقائق مضت, د.كاف يار said:

العفو اخي الكريم يشرفني مرورك و يشرفني أنه نال اعجابك

تفضل طلبك

جزاك الله عنا كل خير دكتور حفظكم الله ورعاكم والشكر موصول للاستاذ محمد ابو عبدالله 

رابط هذا التعليق
شارك

في ٢٢‏/٩‏/٢٠٢٠ at 09:43, د.كاف يار said:

احبتي حتى لا أطيل في الشرح و  بدون مقدمات 

قصتي تتضح من عنواني و نبدء الآن ...

انشئ Module جديد و اضف الكود التالي


Option Explicit
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?hl=" & strFromSourceLanguage & _
    "&sl=" & strFromSourceLanguage & _
    "&tl=" & strToTargetLanguage & _
    "&ie=UTF-8&prev=_m&q=" & strInput
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP") 'late binding
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
End Function

بارك الله بك دكتور حسين التجربة كانت رائعة

 

 

رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information