اذهب الي المحتوي
أوفيسنا

شخابيط وافكار:التأكد من وجود قيمة محددة فى حقل محدد داخل جدول محدد 

ابو جودي

بواسطه ابو جودي
في قسم الأكسيس Access

 مشاركة

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

ابو جودي

ابو جودي

قام بنشر
قام بنشر (معدل)

السلام عليكم ورحمة الله تعالى وبركاته

احيانا نريد التأكد من وجود قيمة محددة فى حقل محدد داخل جدول محدد 
وذلك حتى نتأكد من عدم حدوث تكرار 

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

وظيفة عامة تعمل كروتين من خلال وحدة نمطية بحيث يتم

اسناد القيم التى تخص كل من القيمة واسم الحقل واسم الجدول الى متغيرات عامة ليتم الفحص

يعنى مثل ما سوينا من قبل مع المعرف الخاص البرمجى هنا فى هذا الموضوع 

'|-----------------------------------------------------------|
'|---15/09/1443-------16/04/2022_____________________________|
'|___www.officena.net________________________________________|
'|                                                           |
'|           _  +-----------officena-----------+ _           |
'|          /o) |             |||||            | (o\         |
'|         / /  |           @(~O^O~)@          |  \ \        |
'|        ( (_  | _   ----oOo--Moh--oOo----- _ |  _) )       |
'|       ((\ \) +/o)----------3ssam---------(o\+ (/ /))      |
'|       (\\\ \_/ /                          \ \_/ ///)      |
'|        \      /                            \      /       |
'|         \____/________Mohammed Essam________\____/        |
'|                         15/09/1443                                  |
'|                         16/04/2022                        |
'|                                                           |
'|_____www.officena.net______________________________________|
'|_____Thank you for visiting https://www.officena.net_______|
'|-----------------------------------------------------------|

'======Check Input Exist By Input Type======================================================================================================================================'
'  ____    __    ____ ____    __    ____ ____    __    ____  ______    _______  _______  __    ______  _______ .__   __.      ___         .__   __.  _______ .___________.  '
'  \   \  /  \  /   / \   \  /  \  /   / \   \  /  \  /   / /  __  \  |   ____||   ____||  |  /      ||   ____||  \ |  |     /   \        |  \ |  | |   ____||           |  '
'   \   \/    \/   /   \   \/    \/   /   \   \/    \/   / |  |  |  | |  |__   |  |__   |  | |  ,----'|  |__   |   \|  |    /  ^  \       |   \|  | |  |__   `---|  |----`  '
'    \            /     \            /     \            /  |  |  |  | |   __|  |   __|  |  | |  |     |   __|  |  . `  |   /  /_\  \      |  . `  | |   __|      |  |       '
'     \    /\    /       \    /\    /       \    /\    / __|  `--'  | |  |     |  |     |  | |  `----.|  |____ |  |\   |  /  _____  \   __|  |\   | |  |____     |  |       '
'      \__/  \__/         \__/  \__/         \__/  \__/ (__)\______/  |__|     |__|     |__|  \______||_______||__| \__| /__/     \__\ (__)__| \__| |_______|    |__|       '
'                                                                                                                                                                           '
'==========================================================================================================================================================================='


Public Function CheckInputExist( _
                                ByRef strFieldName As String, _
                                ByRef strTableName As String, _
                                ByVal strObjectContainFieldValue) As Boolean

On Error GoTo ErrorHandler

Dim strFormName         As Access.Form
Dim stLinkCriteria      As String
Dim strMsgTitel         As String
Dim strMsgPrt1          As String
Dim strMsgPrt2          As String

Dim strErrMsgTitel      As String
Dim strErrMsg           As String

Set strFormName = Screen.ActiveForm

strMsgPrt1 = ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1593") & ChrW("1579") & ChrW("1608") & ChrW("1585") & ChrW("32") & ChrW("1593") & ChrW("1604") & ChrW("1609") & ChrW("32") & ChrW("46") & ChrW("46") & ChrW("13") & ChrW("10") & ChrW("40") & ChrW("160")
strMsgPrt2 = ChrW("32") & ChrW("41") & ChrW("13") & ChrW("10") & ChrW("1587") & ChrW("1608") & ChrW("1601") & ChrW("32") & ChrW("1610") & ChrW("1578") & ChrW("1605") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1606") & ChrW("1578") & ChrW("1602") & ChrW("1575") & ChrW("1604") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1609") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1587") & ChrW("1580") & ChrW("1604") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1575") & ChrW("1606")
    
    If Len(strObjectContainFieldValue) = 0 Or IsNull(strObjectContainFieldValue) Then Exit Function

    Select Case FieldTypeName(strFieldName, strTableName)
        Case Is = "Text": stLinkCriteria = strFieldName & "= '" & strObjectContainFieldValue & "'"
        Case Is = "Date/Time": stLinkCriteria = strFieldName & "= #" & Format(strObjectContainFieldValue, "dd/mm/yyyy") & "#"
        Case Is = "Long Integer": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue
        Case Is = "Integer": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue
        Case Is = "Byte": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue
        Case Is = "Single": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue
        Case Is = "Double": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue
        Case Is = "Decimal": stLinkCriteria = strFieldName & "=" & strObjectContainFieldValue
    End Select

    If DCount("*", strTableName, stLinkCriteria) > 0 Then
        MsgBox$ strMsgPrt1 & strObjectContainFieldValue & strMsgPrt2, vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, ""
        strFormName.Undo
        strFormName.Recordset.FindFirst stLinkCriteria
    Else
    End If

procDone:
  Exit Function
ErrorHandler:

 strErrMsgTitel = ChrW("1582") & ChrW("1591") & ChrW("1571") & ChrW("32") & ChrW("1601") & ChrW("1609") & ChrW("32") & ChrW("1606") & ChrW("1608") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578")
 
 strErrMsg = ChrW("1604") & ChrW("1602") & ChrW("1583") & ChrW("32") & ChrW("1581") & ChrW("1575") & ChrW("1608") & ChrW("1604") & ChrW("1578") & ChrW("32") & ChrW("1573") & _
 ChrW("1583") & ChrW("1582") & ChrW("1575") & ChrW("1604") & ChrW("32") & ChrW("1606") & ChrW("1608") & ChrW("1593") & ChrW("32") & ChrW("1576") & ChrW("1610") & _
 ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") & ChrW("32") & ChrW("1594") & ChrW("1610") & ChrW("1585") & ChrW("32") & ChrW("1589") & ChrW("1581") & _
 ChrW("1610") & ChrW("1581") & ChrW("46") & ChrW("46") & ChrW("46") & ChrW("13") & ChrW("10") & ChrW("32") & ChrW("1606") & ChrW("1608") & ChrW("1593") & _
 ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") & ChrW("32") & ChrW("1575") & _
 ChrW("1604") & ChrW("1605") & ChrW("1587") & ChrW("1578") & ChrW("1582") & ChrW("1583") & ChrW("1605") & ChrW("32") & ChrW("1607") & ChrW("1608") & ChrW("32") & _
 ChrW("40") & ChrW("32") & FieldTypeName(strFieldName, strTableName) & ChrW("32") & ChrW("41") & ChrW("13") & ChrW("10") & ChrW("1605") & ChrW("1606") & ChrW("32") & _
 ChrW("1601") & ChrW("1590") & ChrW("1604") & ChrW("1603") & ChrW("32") & ChrW("1602") & ChrW("1605") & ChrW("32") & ChrW("1576") & ChrW("1573") & ChrW("1583") & _
 ChrW("1582") & ChrW("1575") & ChrW("1604") & ChrW("32") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") & ChrW("32") & _
 ChrW("1578") & ChrW("1578") & ChrW("1591") & ChrW("1575") & ChrW("1576") & ChrW("1602") & ChrW("32") & ChrW("1605") & ChrW("1593") & ChrW("32") & ChrW("1606") & _
 ChrW("1608") & ChrW("1593") & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1576") & ChrW("1610") & ChrW("1575") & ChrW("1606") & ChrW("1575") & ChrW("1578") _
 & ChrW("32") & ChrW("1575") & ChrW("1604") & ChrW("1605") & ChrW("1587") & ChrW("1578") & ChrW("1582") & ChrW("1583") & ChrW("1605")

  Select Case Err.Number
    Case Is = 2471: MsgBox$ strErrMsg, vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, strErrMsgTitel
    Case Is = 3075: MsgBox$ strErrMsg, vbCritical + vbMsgBoxRight + vbMsgBoxRtlReading, strErrMsgTitel
    Case Else
    MsgBox$ Err.Number & ": " & Err.Description
 End Select
  Resume procDone

End Function

Public Function FieldTypeName(ByRef strFieldName As String, ByRef strTableName As String) As String
    Dim db As DAO.Database
    Dim objRecordset As DAO.Recordset
    Dim i As Integer
    Set objRecordset = CurrentDb.OpenRecordset(strTableName)
    
For i = 0 To objRecordset.Fields.Count - 1


    If strFieldName = objRecordset.Fields(i).Name Then
Dim strReturn As String

    Select Case CLng(objRecordset.Fields.Item(i).Type) 'fld.Type is Integer, but constants are Long.
        Case dbBoolean: strReturn = "Yes/No"            ' 1
        Case dbByte: strReturn = "Byte"                 ' 2
        Case dbInteger: strReturn = "Integer"           ' 3
        Case dbLong                                     ' 4
            If (objRecordset.Fields.Item(i).Attributes And dbAutoIncrField) = 0& Then
                strReturn = "Long Integer"
            Else
                strReturn = "AutoNumber"
            End If
        Case dbCurrency: strReturn = "Currency"         ' 5
        Case dbSingle: strReturn = "Single"             ' 6
        Case dbDouble: strReturn = "Double"             ' 7
        Case dbDate: strReturn = "Date/Time"            ' 8
        Case dbBinary: strReturn = "Binary"             ' 9 (no interface)
        Case dbText                                     '10
            If (objRecordset.Fields.Item(i).Attributes And dbFixedField) = 0& Then
                strReturn = "Text"
            Else
                strReturn = "Text (fixed width)"        '(no interface)
            End If
        Case dbLongBinary: strReturn = "OLE Object"     '11
        Case dbMemo                                     '12
            If (objRecordset.Fields.Item(i).Attributes And dbHyperlinkField) = 0& Then
                strReturn = "Memo"
            Else
                strReturn = "Hyperlink"
            End If
        Case dbGUID: strReturn = "GUID"                 '15

        'Attached tables only: cannot create these in JET.
        Case dbBigInt: strReturn = "Big Integer"        '16
        Case dbVarBinary: strReturn = "VarBinary"       '17
        Case dbChar: strReturn = "Char"                 '18
        Case dbNumeric: strReturn = "Numeric"           '19
        Case dbDecimal: strReturn = "Decimal"           '20
        Case dbFloat: strReturn = "Float"               '21
        Case dbTime: strReturn = "Time"                 '22
        Case dbTimeStamp: strReturn = "Time Stamp"      '23

        'Constants for complex types don't work prior to Access 2007 and later.
        Case 101&: strReturn = "Attachment"         'dbAttachment
        Case 102&: strReturn = "Complex Byte"       'dbComplexByte
        Case 103&: strReturn = "Complex Integer"    'dbComplexInteger
        Case 104&: strReturn = "Complex Long"       'dbComplexLong
        Case 105&: strReturn = "Complex Single"     'dbComplexSingle
        Case 106&: strReturn = "Complex Double"     'dbComplexDouble
        Case 107&: strReturn = "Complex GUID"       'dbComplexGUID
        Case 108&: strReturn = "Complex Decimal"    'dbComplexDecimal
        Case 109&: strReturn = "Complex Text"       'dbComplexText
        Case Else: strReturn = "unknown"
        End Select
    End If
Next i
    FieldTypeName = strReturn
End Function

يتم استدعاء الوظيقة بشكل عام من خلال الكود الاتى 

Call CheckInputExist("FieldName", "TableName", Me.txtBox)

 

وأخيرا المرفق للتجربة

  • ملاحظة : تم تعديل المرفق والكود بناء على رد استاذى الجليل الباش مهندس @Moosak :fff:

 

التعديل النهائى بتحديث المرفق بتاريخ يوم السبت 22 رمضان 1443 هـ  ,   23 -أبريل -2022 م  

تم إضافة وظيقة للتعرف نوع البيانات المستخدم فى الحقل داخل الجدول 

 

 

 

 

Check Input Exist.accdb

تم تعديل بواسطه ابو جودي
تعديل المرفق بتحديث المرفق بتاريخ يوم السبت 22 رمضان 1443 هـ  ,   23 -أبريل -2022 م  
  • Like 5
abouelhassan

abouelhassan

قام بنشر
قام بنشر

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

طيب فى حالة وجود تكرار فلابد من وجود رسالة أن المدخل مكرر 

شاكرين فضلك وكرمك اخى 

احترامى

 

  • Thanks 1
Moosak

Moosak

قام بنشر
قام بنشر

بعد بسم الله الرحمن الرحيم  😎

جزيل الشكر والإمتنان لك مهندسنا الغالي @ابو جودي

بس عندي ليك كم ملاحظة 😏

أول ملاحظة ( لما يكون الحقل فاضي ) وهذا ينطبق على كل أنواع البيانات :

image.thumb.gif.0dc545a6608010a272ac3614eacd00c1.gif

الملاحظة الثانية ( بعض القيم لا يتم اكتشافها ) على الرغم من أنها موجودة مسبقا ( وينطبق على التواريخ ) :

image.thumb.gif.52228e166f2b278fa62eba9690e9e23e.gif

والباقي زي العسل على الطحينة 😉

 

  • Like 2
ابو جودي

ابو جودي

قام بنشر
  • الكاتب
قام بنشر
7 دقائق مضت, Moosak said:

أول ملاحظة ( لما يكون الحقل فاضي ) وهذا ينطبق على كل أنواع البيانات :

 

طيب ممكن نضيف السطر الاتى للكود وتم التعديل فى المرفق الرئيسي 

If Len(strObjectContainFieldValue) = 0 Or IsNull(strObjectContainFieldValue) Then Exit Function

لكن لم افهم 

8 دقائق مضت, Moosak said:

الملاحظة الثانية ( بعض القيم لا يتم اكتشافها ) على الرغم من أنها موجودة مسبقا ( وينطبق على التواريخ ) :

 

 

  • Like 2
Moosak

Moosak

قام بنشر
قام بنشر
5 دقائق مضت, ابو جودي said:

لكن لم افهم 

13 دقائق مضت, Moosak said:

الملاحظة الثانية ( بعض القيم لا يتم اكتشافها ) على الرغم من أنها موجودة مسبقا ( وينطبق على التواريخ ) :

 

في نموذج التواريخ مثل ما تلاحظ قمت بنسخ نفس القيمة المسجلة مسبقا ثم ضغطت على Check ولكن لم يعطيني رسالة تأكيد وجود التاريخ مسبقا 🙂 

image.gif.95e856c24fefb7db0afada76ffb604e4.gif

  • Like 1
  • Thanks 1
Eng.Qassim

Eng.Qassim

قام بنشر
قام بنشر
1 ساعه مضت, Moosak said:

في نموذج التواريخ مثل ما تلاحظ قمت بنسخ نفس القيمة المسجلة مسبقا ثم ضغطت على Check ولكن لم يعطيني رسالة تأكيد وجود التاريخ مسبقا

استاذ موسى اعتقد المشكلة عندك في اعدادات اللغة

لان التاريخ شغال معاي ...

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

  • Thanks 1
ابو جودي

ابو جودي

قام بنشر
  • الكاتب
قام بنشر

طيب يا استاذ @Moosak  :fff: ,واستاذ   @abouelhassan  :fff:

من فضلكم تجربة المرفق فى رأس الموضوع مرة أخرى 

تم تحديث المرفق السبت 22 رمضان 1443 هـ  ,   23 -أبريل -2022 م  

تم إضافة وظيقة للتعرف نوع البيانات المستخدم فى الحقل داخل الجدول 

والباش مهندس @Eng.Qassim :fff:

ممكن حضرتك توضح قصدك من 

في 16‏/4‏/2022 at 23:41, Eng.Qassim said:

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

أو تفضل وتكرم علينا بالتعديل المناسب كما تراه ربما كانت نظرتكم وفكرتم افضل بكثير 

  • Like 1
abouelhassan

abouelhassan

قام بنشر
قام بنشر

استاذى تمام عند التجربة ب نموذج data 

عند كتابة رقم والضغط على chek خرجت رسالة بتعديل الادخال تمام ممتازة بس فى شئ اخر انظر استاذى

 

1.png.8ecd05dba81f6714e2273e5bd052b406.png

كتبت 1A او1a لايخرج لا اى شئ فكتبت A ,a  ايضا لم يخرج شئ بالرغم ان الاسم مكرر

احترامى وتقديرى اخى الكريم

Eng.Qassim

Eng.Qassim

قام بنشر
قام بنشر
منذ ساعه, ابو جودي said:

ممكن حضرتك توضح قصدك من

قصدت ان الرقم والتاريخ والنص جميعها في نفس النموذج

أبو ألين

أبو ألين

قام بنشر
قام بنشر
في 16‏/4‏/2022 at 22:44, Moosak said:

الملاحظة الثانية ( بعض القيم لا يتم اكتشافها ) على الرغم من أنها موجودة مسبقا ( وينطبق على التواريخ ) :

image.thumb.gif.52228e166f2b278fa62eba9690e9e23e.gif

استاذي عند تجربتي لنموذج التواريخ حصلت معي نفس المشكلة فقمت بتعديل في الوحدة النمطية في جزئية الكود الخاصة بالتاريخ إلى التالي وعمل بشكل سليم .. 

        stLinkCriteria = strFieldName & "= #" & Format(strObjectContainFieldValue, "yyyy-mm-dd") & "#"

لكن لا زالت المشكلة قائمة في نموذج frmDataString مع القيمة 1A .. الكود لا يراها .

  • Like 1
Eng.Qassim

Eng.Qassim

قام بنشر
قام بنشر
18 ساعات مضت, uzer said:

كن لا زالت المشكلة قائمة في نموذج frmDataString مع القيمة 1A .. الكود لا يراها

استبدل جملة التحقق من التاريخ كما يلي:

ينقصها علامتي تنصيص 

 ElseIf IsDate("strObjectContainFieldValue") Then

 

ابو جودي

ابو جودي

قام بنشر
  • الكاتب
قام بنشر

Check Input Exist.accdbتم تحديث المرفق فى رأس الموضوع 

تاربخ تحديث المرفق السبت 22 رمضان 1443 هـ  ,   23 -أبريل -2022 م  

تم إضافة وظيقة للتعرف نوع البيانات المستخدم فى الحقل داخل الجدول 

 

 

  • Like 1
abouelhassan

abouelhassan

قام بنشر
قام بنشر
في 17‏/4‏/2022 at 00:24, abouelhassan said:

استاذى تمام عند التجربة ب نموذج data 

عند كتابة رقم والضغط على chek خرجت رسالة بتعديل الادخال تمام ممتازة بس فى شئ اخر انظر استاذى

 

1.png.8ecd05dba81f6714e2273e5bd052b406.png

كتبت 1A او1a لايخرج لا اى شئ فكتبت A ,a  ايضا لم يخرج شئ بالرغم ان الاسم مكرر

احترامى وتقديرى اخى الكريم

استاذى بارك الله فيك نفس المشكلة فى المرفق الجديد

احترامى

  • Thanks 1
ابو جودي

ابو جودي

قام بنشر
  • الكاتب
قام بنشر
23 دقائق مضت, abouelhassan said:

القاعدة لا تفتح للاسف بارك الله فيك

انا قمت بتحميل المرفق .... القاعدة تفتح وتعمل بشكل طبيعى جدا

  • Like 1
ابو جودي

ابو جودي

قام بنشر
  • الكاتب
قام بنشر
5 دقائق مضت, abouelhassan said:

للاسف استاذنا الفاضل هذا التعديل لا يفتح

بارك الله فيك اخى

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

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.

×
 مشاركة
الذهاب الي قائمه المواضيع
×
×
  • اضف...

Important Information

  I accept