د.كاف يار قام بنشر سبتمبر 22, 2020 مشاركة قام بنشر سبتمبر 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 6 3 رابط هذا التعليق شارك More sharing options...
ازهر عبد العزيز قام بنشر سبتمبر 22, 2020 مشاركة قام بنشر سبتمبر 22, 2020 (معدل) ولا اروع سؤال لو سمحت دكتور هل بالامكان اضافة لغات اضافية بعد مراجعة الرابط الكود ياخذ الترجمة من google مباشرة شكرا دكتور تم تعديل سبتمبر 22, 2020 بواسطه ازهر عبد العزيز رابط هذا التعليق شارك More sharing options...
محمد سلامة قام بنشر سبتمبر 22, 2020 مشاركة قام بنشر سبتمبر 22, 2020 (معدل) جزاك الله خيراً د.كاف🌹 هل يتطلب وجود انترنت علي الجهاز؟ تحياتي تم تعديل سبتمبر 22, 2020 بواسطه محمد سلامة رابط هذا التعليق شارك More sharing options...
د.كاف يار قام بنشر سبتمبر 22, 2020 الكاتب مشاركة قام بنشر سبتمبر 22, 2020 22 دقائق مضت, ازهر عبد العزيز said: ولا اروع سؤال لو سمحت دكتور هل بالامكان اضافة لغات اضافية بعد مراجعة الرابط الكود ياخذ الترجمة من google مباشرة شكرا دكتور نعم تستطيع اضافة لغات اخرى فقط في اللغة المقابلة ضع رمز اللغة مثلا عربي ar انجلش en و هكذا .... ابحث عن رموز اللغات 14 دقائق مضت, محمد سلامة said: جزاك الله خيراً د.كاف🌹 هل يتطلب وجود انترنت علي الجهاز؟ تحياتي نعم يتطلب وجود انترنت 2 رابط هذا التعليق شارك More sharing options...
ازهر عبد العزيز قام بنشر سبتمبر 22, 2020 مشاركة قام بنشر سبتمبر 22, 2020 دكتور لو سمحت هل بالامكان اضافة رسالة تحذيرة قي حال عدم توفر الانترنت الى الكود رابط هذا التعليق شارك More sharing options...
أفضل إجابة محمد أبوعبدالله قام بنشر سبتمبر 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 تحياتي 4 رابط هذا التعليق شارك More sharing options...
د.كاف يار قام بنشر سبتمبر 23, 2020 الكاتب مشاركة قام بنشر سبتمبر 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 تحياتي ماشاء الله اضافة ممتازة و اشكرك على الرد رابط هذا التعليق شارك More sharing options...
ازهر عبد العزيز قام بنشر سبتمبر 23, 2020 مشاركة قام بنشر سبتمبر 23, 2020 12 ساعات مضت, محمد أبوعبدالله said: تفضل اخي الكريم ماشاء الله ولا اروع شكرا جزيلا اخي رابط هذا التعليق شارك More sharing options...
محمد حمزه قام بنشر سبتمبر 23, 2020 مشاركة قام بنشر سبتمبر 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 ولكنه تفشل معي هل الترجمه تنص فقط على الليبل فقط ولا تنطبق على ماهو داخل النص شكرا لكم رابط هذا التعليق شارك More sharing options...
د.كاف يار قام بنشر سبتمبر 24, 2020 الكاتب مشاركة قام بنشر سبتمبر 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 2 1 رابط هذا التعليق شارك More sharing options...
Ali Mohamed Ali قام بنشر سبتمبر 24, 2020 مشاركة قام بنشر سبتمبر 24, 2020 أحسنت استاذ حسين عمل ممتاز بارك الله فيك وزادك الله من فضله 3 رابط هذا التعليق شارك More sharing options...
د.كاف يار قام بنشر سبتمبر 24, 2020 الكاتب مشاركة قام بنشر سبتمبر 24, 2020 (معدل) 1 ساعه مضت, Ali Mohamed Ali said: أحسنت استاذ حسين عمل ممتاز بارك الله فيك وزادك الله من فضله العفو اخي الكريم الأجمل هو مرورك العطر و الجميل شكرا لك ============================================= الاخوة الأعزاء تم اضافة اللغات المعتمدة في Google تجدون النسخة المعدلة في المرفقات translate_language.accdb تم تعديل سبتمبر 24, 2020 بواسطه د.كاف يار 2 رابط هذا التعليق شارك More sharing options...
ازهر عبد العزيز قام بنشر سبتمبر 24, 2020 مشاركة قام بنشر سبتمبر 24, 2020 18 دقائق مضت, د.كاف يار said: الاخوة الأعزاء تم اضافة اللغات المعتمدة في Google تجدون النسخة المعدلة في المرفقات ابداع ليس له حدود هل بالامكان اضافة الرسالة التحذيرة بعدم وجود الانترنت للاستاذ محمد فلم استطع اضافتها واكم منا جزيل الشكر والعرفان رابط هذا التعليق شارك More sharing options...
د.كاف يار قام بنشر سبتمبر 24, 2020 الكاتب مشاركة قام بنشر سبتمبر 24, 2020 منذ ساعه, ازهر عبد العزيز said: ابداع ليس له حدود هل بالامكان اضافة الرسالة التحذيرة بعدم وجود الانترنت للاستاذ محمد فلم استطع اضافتها واكم منا جزيل الشكر والعرفان العفو اخي الكريم يشرفني مرورك و يشرفني أنه نال اعجابك تفضل طلبك translate_language.accdb 3 رابط هذا التعليق شارك More sharing options...
ازهر عبد العزيز قام بنشر سبتمبر 24, 2020 مشاركة قام بنشر سبتمبر 24, 2020 2 دقائق مضت, د.كاف يار said: العفو اخي الكريم يشرفني مرورك و يشرفني أنه نال اعجابك تفضل طلبك جزاك الله عنا كل خير دكتور حفظكم الله ورعاكم والشكر موصول للاستاذ محمد ابو عبدالله رابط هذا التعليق شارك More sharing options...
god009 قام بنشر سبتمبر 24, 2020 مشاركة قام بنشر سبتمبر 24, 2020 الموضوع فى قمة الروعة والابداع كل الشكر موصول لاستاذنا الرائع صاحب الموضوع رابط هذا التعليق شارك More sharing options...
محمد عبد الله ٢ قام بنشر سبتمبر 24, 2020 مشاركة قام بنشر سبتمبر 24, 2020 @د.كاف يار الموضوع فى قمة الروعة والابداع كل الشكر لك أستاذي الفاضل رابط هذا التعليق شارك More sharing options...
محمد التميمي قام بنشر سبتمبر 25, 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 بارك الله بك دكتور حسين التجربة كانت رائعة رابط هذا التعليق شارك More sharing options...
walidalrobey@yahoo.com قام بنشر سبتمبر 27, 2020 مشاركة قام بنشر سبتمبر 27, 2020 ربنا يبارك لكم جميعا -- ما شاء الله على الجمال ذادكم الله من فضله زعلمة رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.