محتاج كود لضبط الهمزات

**2saad** · أغسطس 29

إخواني الأعزاء بعد سلام الله عليكم ورحمة الله وبركاته

محتاج كود لضبط الهمزات بمعني ( أ - آ - إ - ة - ى ) تحول إلي ( ا-ا-ا-ه - ي ) وكذلك الأسماء التي تبدأ ب بكلمة ( عبد ) تحول من غير مسافة ( عبد ) مثل ( عبدالرحمن )

وكود يأبجد الأسماء بناء علي ذلك بحيث يبدأ بالذكور أولا

ولكم جزيل الشكر

**2saad** · أغسطس 30

منتظر رد الأخوة الأفاضل

عبدالله بشير عبدالله · أغسطس 30

السلام عليكم / طرحت سؤالك على موقع برنامج الذكاء الاصطناعي واتمنى من الخبراء ابداء رأيهم في الكود علما بأن صيغة السؤال كانت كالتالي :-محتاج كوداكسس لضبط الهمزات بمعني ( أ - آ - إ - ة - ى ) تحول إلي ( ا-ا-ا-ه - ي )

فاجابنى :

يمكنك استخدام الكود التالي في VBA لضبط الهمزات في النصوص داخل قاعدة بيانات Access. هذا الكود يقوم بتحويل الأحرف (أ - آ - إ - ة - ى) إلى (ا - ا - ا - ه - ي):

Function AdjustHamzat(inputText As String) As String
    Dim adjustedText As String
    adjustedText = inputText
    
    adjustedText = Replace(adjustedText, "أ", "ا")
    adjustedText = Replace(adjustedText, "آ", "ا")
    adjustedText = Replace(adjustedText, "إ", "ا")
    adjustedText = Replace(adjustedText, "ة", "ه")
    adjustedText = Replace(adjustedText, "ى", "ي")
    
    AdjustHamzat = adjustedText
End Function

Sub UpdateHamzatInTable()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim fieldName As String
    Dim tableName As String
    
    ' اسم الجدول واسم الحقل المراد تحديثه
    tableName = "YourTableName"
    fieldName = "YourFieldName"
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT * FROM " & tableName)
    
    If Not rs.EOF Then
        rs.MoveFirst
        Do While Not rs.EOF
            rs.Edit
            rs(fieldName).Value = AdjustHamzat(rs(fieldName).Value)
            rs.Update
            rs.MoveNext
        Loop
    End If
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

هذا الكود يحتوي على دالة AdjustHamzat التي تقوم بتحويل الأحرف المطلوبة، ودالة UpdateHamzatInTable التي تقوم بتحديث الحقل المحدد في الجدول. تأكد من تعديل YourTableName وYourFieldName بأسماء الجدول والحقل المناسبين في قاعدة البيانات الخاصة بك.

انتهت اجابة الموقع نتمنى ان تجربه وتخبرنا بالنتيجة كذلك يجب تفعيل مكتبةDAO

تم تعديل أغسطس 30 بواسطه عبدالله بشير عبدالله

عبدالله بشير عبدالله · أغسطس 30

اما طلبك الثاني فاجابنى

يمكنك استخدام الكود التالي في Microsoft Access لضبط الأسماء التي تبدأ بكلمة “عبد” وتحويلها إلى الشكل الصحيح بدون مسافة، مثل “عبدالرحمن”:

Sub AdjustNames()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim name As String
    
    Set db = CurrentDb
    Set rs = db.OpenRecordset("SELECT [اسم_الحقل] FROM [اسم_الجدول]")

    Do While Not rs.EOF
        name = rs!اسم_الحقل
        ' Check if the name starts with "عبد " (with a space)
        If Left(name, 4) = "عبد " Then
            ' Remove the space after "عبد"
            rs.Edit
            rs!اسم_الحقل = Replace(name, "عبد ", "عبد")
            rs.Update
        End If
        rs.MoveNext
    Loop

    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

تأكد من استبدال [اسم_الحقل] و [اسم_الجدول] بأسماء الحقل والجدول الفعلية في قاعدة البيانات الخاصة بك. هذا الكود يقوم بالبحث في الحقل المحدد في الجدول، وإذا وجد اسمًا يبدأ بـ "عبد " (مع مسافة)، يقوم بإزالة المسافة

**ابوخليل** · أغسطس 30

بالنسبة للهمزات هذا يفي بالغرض ... نضعه في الاستعلام

name2: Replace(Replace(Replace(Replace(Replace(Replace([tabeNames].[name1];'أ';'ا');'إ';'ا');'ة';'ه');'ه';'ه');'ى';'ي');'ي';'ى')

على اعتبار name1 هو حقل الاسم في الجدول

عبدالله بشير عبدالله · أغسطس 30

اما طلبك الاخير فاجابنى

يمكنك استخدام الكود التالي في Microsoft Access لفرز الأسماء أبجديًا بحيث يبدأ بالذكور أولاً، ثم الإناث. سنفترض أن لديك حقلًا يسمى “الجنس” يحتوي على “ذكر” أو “أنثى”، وحقلًا آخر يسمى “الاسم” يحتوي على الأسماء

Sub SortNamesByGender()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim sql As String
    
    Set db = CurrentDb
    
    ' SQL query to sort names by gender first, then alphabetically
    sql = "SELECT * FROM [اسم_الجدول] ORDER BY [الجنس] DESC, [الاسم] ASC"
    
    Set rs = db.OpenRecordset(sql)
    
    ' Loop through the sorted recordset and print names (or perform any other action)
    Do While Not rs.EOF
        Debug.Print rs!الاسم
        rs.MoveNext
    Loop
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

تأكد من استبدال [اسم_الجدول] بأسم الجدول الفعلي في قاعدة البيانات الخاصة بك. هذا الكود يقوم بفرز الأسماء بحيث يبدأ بالذكور أولاً (لأننا نستخدم DESC في ترتيب الجنس)، ثم يرتب الأسماء أبجديًا

اسم الموقع وهو مجاني ويحتاج تسجيل الاشتراك فيه

https://copilot.microsoft.com/

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

تم تعديل أغسطس 30 بواسطه عبدالله بشير عبدالله

**ابوخليل** · أغسطس 30

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

السلام عليكم / طرحت سؤالك على موقع برنامج الذكاء الاصطناعي واتمنى من الخبراء ابداء رأيهم في الكود

جميل جدا اخي عبدالله .. هذا الذكاء رصين في كتابة الكود وخطواته

ولكن التغيير في الجدول احيانا غير مرغوب .. فمثلا اسمي إبراهيم فأنا لا اريد ان يظهر اسمي في التقرير ابراهيم بدون همز

لا ننسى أن التعديل داخل الجداول محظور غالبا

جميل لو كانت هذه الدالة في عمود خاص في الاستعلام من اجل التصفية والبحث

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

**ابوخليل** · أغسطس 30

30 دقائق مضت, ابوخليل said:

جميل لو كانت هذه الدالة في عمود خاص في الاستعلام من اجل التصفية والبحث

اعني الدالة الثانية الخاصة بـــ "عبد"

اما الأولى فأعتقد انها جاهزة للعمل

عبدالله بشير عبدالله · أغسطس 30

معلمنا ابو خليل /

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

ووضعت سؤالك التالي حرفيا ولكن التغيير في الجدول احيانا غير مرغوب .. فمثلا اسمي إبراهيم فأنا لا اريد ان يظهر اسمي في التقرير ابراهيم بدون همز جميل لو كانت هذه الدالة في عمود خاص في الاستعلام من اجل التصفية والبحث فاجابنى

فهمت، يمكنك استخدام الدالة في استعلام Access بحيث يتم إنشاء عمود جديد يحتوي على النصوص المعدلة دون التأثير على البيانات الأصلية في الجدول. إليك كيفية القيام بذلك:

افتح قاعدة البيانات في Access.
أنشئ استعلامًا جديدًا.
في تصميم الاستعلام، أضف الجدول الذي يحتوي على الأسماء.
في عمود جديد في شبكة التصميم، أدخل التعبير التالي
```
AdjustedName: AdjustHamzat([اسم_العمود])
```
حيث “اسم_العمود” هو اسم العمود الذي يحتوي على الأسماء الأصلية.

إليك الكود الكامل للدالة التي يمكنك استخدامها في وحدة نمطية (Module) في Access
```
Function AdjustHamzat(inputText As String) As String
    Dim result As String
    result = Replace(inputText, "أ", "ا")
    result = Replace(result, "آ", "ا")
    result = Replace(result, "إ", "ا")
    result = Replace(result, "ة", "ه")
    result = Replace(result, "ى", "ي")
    AdjustHamzat = result
End Function
```
بهذه الطريقة، يمكنك استخدام العمود الجديد “AdjustedName” في التصفية والبحث دون التأثير على الأسماء الأصلية في الجدول. إذا كنت بحاجة إلى أي مساعدة إضافية، لا تتردد في السؤال! انتهى كلام الذكاء
واذا كانت الاجابة غير مرضيه اخبره بذلك وسيعطيك حلولا اخرى

**ابوخليل** · أغسطس 30

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

واذا كانت الاجابة غير مرضيه اخبره بذلك وسيعطيك حلولا اخرى

ولد صالح 😊

عبدالله بشير عبدالله · أغسطس 30

قدمت له سؤالك كما هو فاجابنى

6 دقائق مضت, ابوخليل said:

جميل لو كانت هذه الدالة في عمود خاص في الاستعلام من اجل التصفية والبحث

يمكنك إنشاء استعلام في Microsoft Access يحتوي على عمود محسوب يستخدم دالة لتعديل الأسماء مباشرة في الاستعلام. إليك كيفية القيام بذلك:

افتح قاعدة البيانات الخاصة بك في Access.
انتقل إلى علامة التبويب “إنشاء” واختر “تصميم استعلام”.
أضف الجدول الذي يحتوي على الأسماء التي تريد تعديلها.
في عمود جديد في شبكة تصميم الاستعلام، أدخل التعبير التالي:

NewName: IIf(Left([YourFieldName], 4) = "عبد ", "عبد" & Mid([YourFieldName], 5), [YourFieldName])

تأكد من استبدال YourFieldName باسم الحقل الفعلي الذي يحتوي على الأسماء.

هذا التعبير يقوم بإنشاء عمود جديد يسمى “NewName” في الاستعلام، حيث يتم إزالة المسافة بين “عبد” وبقية الاسم إذا كانت موجودة. يمكنك الآن استخدام هذا العمود الجديد للتصفية والبحث في الاستعلام.

انتهت الاجابة

**ابوخليل** · أغسطس 30

اذا بدون وحدات نمطية او دوال عدا Replace يتم اختصار المهمتين في هذا السطر

NewName: IIf(Left([sName];4)="عبد ";"عبد" & Mid([sName];5);IIf([sname]<>"";Replace(Replace(Replace(Replace(Replace(Replace([sname];'أ';'ا');'إ';'ا');'ة';'ه');'ه';'ه');'ى';'ي');'ي';'ى');[sname]))

**2saad** · أغسطس 30

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

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

وكمان زودت عليها كلمة ( عبد )

ولكن بالنسبة لكود الأبجدة

Sub SortNamesByGender()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim sql As String
    
    Set db = CurrentDb
    
    ' SQL query to sort names by gender first, then alphabetically
    sql = "SELECT * FROM [اسم_الجدول] ORDER BY [الجنس] DESC, [الاسم] ASC"
    
    Set rs = db.OpenRecordset(sql)
    
    ' Loop through the sorted recordset and print names (or perform any other action)
    Do While Not rs.EOF
        Debug.Print rs!الاسم
        rs.MoveNext
    Loop
    
    rs.Close
    Set rs = Nothing
    Set db = Nothing
End Sub

أين أضع هذا الكود ؟

وكيف استدعيه ؟

واستدعيه في جدول أم في الاستعلام ؟

شكرا لكم جميعا

عبدالله بشير عبدالله · أغسطس 31

اعدت السؤال مرة اخرى على الذكاء الاصطناعي فاعطاني حل اخر وانقله لك كما هو

لتنفيذ ترتيب الأسماء بحيث يبدأ بالذكور أولاً في Microsoft Access، يمكنك استخدام استعلام SQL مخصص. إليك كيفية القيام بذلك:

افتح قاعدة البيانات في Access.
انتقل إلى علامة التبويب “إنشاء” واختر “استعلام تصميم”.
أغلق نافذة “إظهار الجدول”.
انتقل إلى علامة التبويب “تصميم” واختر “عرض SQL”.

أدخل الكود التالي في نافذة SQL

SELECT *
FROM جدول_الأسماء
ORDER BY 
    IIf(جنس = 'ذكر', 0, 1), 
    اسم;

في هذا الكود:

جدول_الأسماء هو اسم الجدول الذي يحتوي على الأسماء.
جنس هو اسم الحقل الذي يحتوي على الجنس (ذكر أو أنثى).
اسم هو اسم الحقل الذي يحتوي على الأسماء.
هذا الاستعلام سيقوم بترتيب الأسماء بحيث تظهر الأسماء الذكورية أولاً، ثم الأسماء الأنثوية، وكل منها مرتبة أبجدياً.

**ابوخليل** · أغسطس 31

تبجيد الاسماء مع فرز الذكور اولا ثم الإناث

لست بحاجة الى اكواد

في الاستعلام :

خانة الفرز (sort) في الحقلين اختر تصاعدي

عند ادراج الحقول في الاستعلام اجعل حقل الجنس يسبق حقل الاسم ، من اجل تكون الاولوية هي فرز الجنس اولا

hanan_ms · أغسطس 31

بعد اذنكم ❤️🌹🌹

+ Video + طريقة ثانية ☕

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

لتصحيح المسميات والهمزات وصحة المدخلات

عند انتهاء من كتابة الاسم اضغط دبل اكليك بالماوس

ويوجد خيار اذا كان الاسم جديد يمكن اضافة عند الاخال

لو عند فتح نموذج الفحص والتصحيح = اتصال وربط للقاعدة الاسماء والاغلاق اعادة ربط قاعدة المشروع 😇 من غير ازدحام

===============================================( هل نموذج مفيد )

1- تخصيص خيار الفحص لاي نموذج حتى آخر تفريع في النموذج

2.PNG.b8eecfdd1bdcc48f21e9c33f98c724e1.PNG

2- تحديد التصحيح

3.PNG.adbe013a5b124431420bb20d84e7e11e.PNG

'================================(Cod Only One in Form One On All Form)

If Me.h1 = 1 Then
'On Error GoTo Form_Open_Err
'================================( Chack Spaec Text )
Dim sp As Integer
Dim spp1 As String
Dim spp2 As String
Dim spp3 As String

For sp = 1 To 3
'If sp = 1 Then Me.s1 = Str_Txt(Me.T_C1) ' Delete space from start text
'If sp = 2 Then Me.ss2 = End_Text(Me.s1) ' Delete space from end text
'If sp = 3 Then Me.s3 = Mod_Txt(Me.ss2) '  text space end 1
Next
On Error Resume Next
Me.T_C1 = End_Text(Me.T_C1)
'Str_Txt (Me.T_C1)
'=============================( Form_To_TextBox)
Dim bForm As String
Dim bTextBox As String
bForm = Me.frm
bTextBox = Me.txt
'=============================( Aout )
    Dim bEnabled As Boolean
     Dim strength As String
    Dim hasUpperCase As Boolean
    Dim hasLowerCase As Boolean
    Dim hasArCase As Boolean
    Dim hasDigit As Boolean
    Dim hasSpecialChar As Boolean
    '========================(Cahck Contril_Text_Auto)
    Dim bEn_A As Boolean
    Dim bEn_aa As Boolean
    Dim bAr As Boolean
    Dim bSomipl As Boolean
    Dim bN9 As Boolean
    Dim bSpaice As Boolean
    Dim bNumber_Text As Boolean
    Dim bN_T As String ' No Use Error As Long
    '============================( Run DlookUP IF Form And TextBox )
    bEn_A = DLookup("[En-Captial]", "Save_Text_Chack ", " [name_frm] ='" & [Forms]![frmCahck_text]![frm] & "'  And [name_chack_textBox] ='" & [Forms]![frmCahck_text]![txt] & "' ")
    bEn_aa = DLookup("[En-Smoll]", "Save_Text_Chack ", " [name_frm] ='" & [Forms]![frmCahck_text]![frm] & "'  And [name_chack_textBox] ='" & [Forms]![frmCahck_text]![txt] & "' ")
    bAr = DLookup("[Ar]", "Save_Text_Chack ", " [name_frm] ='" & [Forms]![frmCahck_text]![frm] & "'  And [name_chack_textBox] ='" & [Forms]![frmCahck_text]![txt] & "' ")
    bSomipl = DLookup("[sompil]", "Save_Text_Chack ", " [name_frm] ='" & [Forms]![frmCahck_text]![frm] & "'  And [name_chack_textBox] ='" & [Forms]![frmCahck_text]![txt] & "' ")
    bN9 = DLookup("[N9]", "Save_Text_Chack ", " [name_frm] ='" & [Forms]![frmCahck_text]![frm] & "'  And [name_chack_textBox] ='" & [Forms]![frmCahck_text]![txt] & "' ")
    bSpaice = DLookup("[Space_1]", "Save_Text_Chack ", " [name_frm] ='" & [Forms]![frmCahck_text]![frm] & "'  And [name_chack_textBox] ='" & [Forms]![frmCahck_text]![txt] & "' ")
    bNumber_Text = DLookup("[Number_Text]", "Save_Text_Chack ", " [name_frm] ='" & [Forms]![frmCahck_text]![frm] & "'  And [name_chack_textBox] ='" & [Forms]![frmCahck_text]![txt] & "' ")
    If IsNull(DLookup("[N_text]", "Save_Text_Chack ", " [name_frm] ='" & [Forms]![frmCahck_text]![frm] & "'  And [name_chack_textBox] ='" & [Forms]![frmCahck_text]![txt] & "' ")) Then
    Else
    bN_T = DLookup("[N_text]", "Save_Text_Chack ", " [name_frm] ='" & [Forms]![frmCahck_text]![frm] & "'  And [name_chack_textBox] ='" & [Forms]![frmCahck_text]![txt] & "' ")
    End If
    On Error Resume Next
    '==============================
            Dim s2 As String
              Dim ss As String
            s2 = Me.T_C1
            
If bEn_A = -1 Then
Dim cc1 As Integer
    For cc1 = 1 To Len(s2)
        ss = Mid(s2, cc1, 1)
        If ss Like "[A-Z]" Then
        hasUpperCase = True
        MsgBox "chang No Use lang En_captial- {[ " & s2 & " ]}- ", vbExclamation, " close don  " & Date
        s2 = ""
                txt_On_txt = ""
        DoCmd.Close acForm, Me.Form.Name
        Exit Sub
        End If
    Next cc1
    Else
    End If

If bEn_aa = -1 Then
Dim cc2 As Integer
    For cc2 = 1 To Len(s2)
        ss = Mid(s2, cc2, 1)
        If ss Like "[a-z]" Then
        hasLowerCase = True
        MsgBox "chang No Use lang En_Smoll- {[ " & s2 & " ]}- ", vbExclamation, " close don  " & Date
        s2 = ""
        txt_On_txt = ""
        DoCmd.Close acForm, Me.Form.Name
        Exit Sub
        End If
    Next cc2
    Else
    End If

If bAr = -1 Then
Dim cc3 As Integer
    For cc3 = 1 To Len(s2)
        ss = Mid(s2, cc3, 1)
        If ss Like "[Ç-í]" Then
        hasArCase = True
        MsgBox "chang No Use lang Ar- {[ " & s2 & " ]}- ", vbExclamation, " close don  " & Date
        s2 = ""
                txt_On_txt = ""
        DoCmd.Close acForm, Me.Form.Name
        Exit Sub
        End If
    Next cc3
    Else
    End If

If bN9 = -1 Then
Dim cc4 As Integer
    For cc4 = 1 To Len(s2)
        ss = Mid(s2, cc4, 1)
        If ss Like "[0-9]" Then
        hasDigit = True
        MsgBox "chang lang Ar- {[ " & s2 & " ]}- ", vbExclamation, " close don  " & Date
        s2 = ""
                txt_On_txt = ""
        DoCmd.Close acForm, Me.Form.Name
        Exit Sub
        End If
    Next cc4
    Else
    End If

If bSomipl = -1 Then
Dim cc5 As Integer
    For cc5 = 1 To Len(s2)
        ss = Mid(s2, cc5, 1)
        If ss Like "[!@#$%^&*()_+{}:<>?~]" Then
        hasSpecialChar = True
        MsgBox "chang lang Somipl- {[ " & s2 & " ]}- ", vbExclamation, " close don  " & Date
        s2 = ""
                txt_On_txt = ""
        DoCmd.Close acForm, Me.Form.Name
       Exit Sub
        End If
    Next cc5
    Else
    End If

If bSpaice = -1 Then
Dim cc6 As Integer
    For cc6 = 1 To Len(s2)
        ss = Mid(s2, cc6, 1)
        If ss Like "[""]" Then
        s2 = ""
                txt_On_txt = ""
       DoCmd.Close acForm, Me.Form.Name
        Exit Sub
        End If
    Next cc6
    Else
    End If

If bNumber_Text = -1 Then
    If bN_T > Len(s2) Then
Else
MsgBox "chang lang Ar- {[ " & s2 & " ]}- ", vbExclamation, " close don  " & Date
        s2 = ""
                txt_On_txt = ""
        DoCmd.Close acForm, Me.Form.Name
        Exit Sub
        End If
        Else
End If

If DCount("[ID]", "[Chack_text_on_text]") = 0 Then
Me.cmd_New.Enabled = True
Else
Me.T_C2 = DLookup("[name_K]", "[Chack_text_on_text]")
Me.T_C2.Enabled = False
Me.cmd_New.Enabled = False
End If
    If IsDate(txt_On_txt) Then
       Me.s1 = txt_On_txt.Value
    Else
       Me.s1 = Date
   End If
    
Me.h1 = 0
End If
Form_Open_Exit:
    Exit Sub

Form_Open_Err:
    MsgBox Err.Description, vbCritical, "frmCalendar.Form_Open"
    Resume Form_Open_Exit
End Sub

1.PNG.f66af5523982b58b7d9ab31c1e5c2702.PNG

Text_Change_Auto_Ms_Access.rar

تسجيل الدخول

محتاج كود لضبط الهمزات

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

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

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

شارك

من فضلك سجل دخول لتتمكن من التعليق

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

Important Information