الترجمة في اكسس

[sm44ms]

مساءكم الله بالخير جميع
من يرغب في ترجمة الاسم العربي الى انجليزي بكود بسيط يخبرني
كذلك ترجمة الجنسية من العربي الى الانجليزي يخبرني
ترجمة فورية

لمصلحة هذا المنتدى الرائع؟

فقط اعطني اسم الحقول ومربع التحرير والسرد في نظامك ؟ مثال؟

اسم مربع التحرير ااذا كانت فيه الجنسيات بالعربي

مربع تحرير الجنسية الانجليزي

اسم حقل الاسم العربي 

اسم مربع الحقل الانجليزي

تكــــــــــــــــــــــــــــــــــــــــــــــــون اسماء الحقول انجليزي 

واموركم في الروبه

[Foksh]

مساهمة طيلة منك اخي الكريم..

سؤالي البسيط ، هل يحتاج انترنت  ؟؟

لنجرب مثلاً ، عندي مربع تحرير وسرد اسمه "Drive_Nat" ويضم جنسيات مختلفة 😇 .

تم تعديل الأربعاء at 10:04 بواسطه Foksh

[sm44ms]

هلاهلا  - وهل يفتي ومالك في المدينة؟

ع العموم شكرا على تواضعك هذا - اما بخصوص الانترنت نعم يجب ان تكون متصل بالانترنت؟ 

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

نعود للكود

Private Sub Drive_Nat_AfterUpdate()

    On Error Resume Next
    
    ' استدعاء الدالة Translate لترجمة الجنسية العربي إلى الإنجليزي
    Dim translatedText As String
    translatedText = Translate(Me.Drive_Nat.Value, "ar", "en")                '  هذه هو مربع التحرير الخاص بك Drive_Nat 
    
    ' تحديث حقل الجنسيات الإنجليزية NASH
    If Not IsNull(translatedText) And translatedText <> "" Then             '   NASH    وهذا مربع التحرير الخاص بالجنسية العربية اذا كان لديك 
        Me.NASH.Value = translatedText
    Else
        MsgBox "تعذر الترجمة. يرجى المحاولة مرة أخرى.", vbExclamation, "خطأ في الترجمة"
    End If
    

 ' وهذا حقل الجنسية العربيه بحيث ييم الترجمة فيه 
    ' تحديث الحقل NAOINALTYEN  بناءً على الترجمة                                                                
    If Not IsNull(Me.NASH.Value) And Me.NASH.Value <> "" Then
        Me.NAOINALTYEN.Value = Me.NASH.Value
    End If

    ' استدعاء الكود الخاص بتحديث الصور
    Call NASH_AfterUpdate
End Sub





قبل ذلك تضع هذا الكود في وحدة نمطية واحفظها



Option Compare Database

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?sl=" & strFromSourceLanguage & "&tl=" & strToTargetLanguage & "&q=" & EncodeQP2(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
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

 

 

تم تعديل منذ 1 ساعه بواسطه jjafferr
لتنسيق الكود: من قائمة مربع الرسائل، اختار <> ، ثم ضع الكود فيه