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

**د.كاف يار** · سبتمبر 22, 2020

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

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

انشئ 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

**ازهر عبد العزيز** · سبتمبر 22, 2020

ولا اروع

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

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

تم تعديل سبتمبر 22, 2020 بواسطه ازهر عبد العزيز

**محمد سلامة** · سبتمبر 22, 2020

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

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

تحياتي

تم تعديل سبتمبر 22, 2020 بواسطه محمد سلامة

**د.كاف يار** · سبتمبر 22, 2020

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

ولا اروع

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

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

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

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

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

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

تحياتي

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

**ازهر عبد العزيز** · سبتمبر 22, 2020

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

**محمد أبوعبدالله** · سبتمبر 22, 2020

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

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

تحياتي

**د.كاف يار** · سبتمبر 23, 2020

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

تحياتي

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

**ازهر عبد العزيز** · سبتمبر 23, 2020

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

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

ماشاء الله ولا اروع شكرا جزيلا اخي

محمد حمزه · سبتمبر 23, 2020

د.كاف يار

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

نعم تم تشغيل معي بدون غلطه 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

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

شكرا لكم

**د.كاف يار** · سبتمبر 24, 2020

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

**Ali Mohamed Ali** · سبتمبر 24, 2020

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

**د.كاف يار** · سبتمبر 24, 2020

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

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

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

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

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

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

translate_language.accdb

تم تعديل سبتمبر 24, 2020 بواسطه د.كاف يار

**ازهر عبد العزيز** · سبتمبر 24, 2020

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

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

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

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

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

**د.كاف يار** · سبتمبر 24, 2020

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

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

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

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

تفضل طلبك

translate_language.accdb

**ازهر عبد العزيز** · سبتمبر 24, 2020

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

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

تفضل طلبك

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

god009 · سبتمبر 24, 2020

الموضوع فى قمة الروعة والابداع كل الشكر موصول لاستاذنا الرائع صاحب الموضوع

محمد عبد الله ٢ · سبتمبر 24, 2020

@د.كاف يار

الموضوع فى قمة الروعة والابداع كل الشكر لك أستاذي الفاضل

**محمد التميمي** · سبتمبر 25, 2020

في ٢٢‏/٩‏/٢٠٢٠ 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

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

walidalrobey@yahoo.com · سبتمبر 27, 2020

ربنا يبارك لكم جميعا -- ما شاء الله على الجمال

ذادكم الله من فضله زعلمة

تسجيل الدخول

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

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

د.كاف يار

ازهر عبد العزيز

محمد سلامة

د.كاف يار

ازهر عبد العزيز

محمد أبوعبدالله

د.كاف يار

ازهر عبد العزيز

محمد حمزه

د.كاف يار

د.كاف يار

د.كاف يار

Ali Mohamed Ali

د.كاف يار

ازهر عبد العزيز

د.كاف يار

ازهر عبد العزيز

god009

محمد عبد الله ٢

محمد التميمي

walidalrobey@yahoo.com

Join the conversation

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information