خربشات في الأكسس

اخي واستاذي الكبير مصلح الحريصي

جزاك الله كل خير

نحن في انتظار مشاركتم بما تجود به اناملك الطاهره .

اخي ومعلمي احمد الحربي

ياليل ما اطولك .... المشوار باقي طوييييييييييييييييييييييييييييييييييل جدا

احاول ان انتهي من الخرابيش الكبيرة لنبدأ في الخرابيش ( الهامبورقر ) الخفيفة وسريعة الهظم .

بهذه الطريقه سنحتاج الى سنه ضوئيه ( 300 عام ) لإكمال هذا الموضوع .

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

*******************************************

* كل الخرابيش تنـــادي ......... بالله شارك معانـــا *

* ترى الموضوع عادي ......... والخير في منتدانا *

*******************************************

لايمنع اخي فهد من المشاركة بأي شيء فالموضوع مفتوح للجميع بأي تعلومه او فكره ( قديمة - جديده ) فأعلم ان لديك من الافكار مالا تخطر على بال احد .

اخي ابو وليد

سنتطرق للشرح ان شاء الله عن موضوع ( اصنع دالتك ينفسك ) وسيكون بإذن الله طلبك في مقدمة المواضيع .

الغرض : التسهيل على المستخدم في اختيار الانماط الخاصة به بعيدا عن الانماط القياسية الخاصة ببرنامج الاكسيس

طريقة عمل الانماط الخاصة بك

1. قم بإنشاء قاعدة بيانات جديده .

2. قم بإنشاء جدول به على الاقل 3 حقول

3. قم بعمل نموذج مبني على الجدول السابق ( ودع النمط على الوضع القياسي - اللون الرمادي )

4. احفظ عملك ( يحفظك الله ويرعاك ) .

5. افتح النموذج السابق في وضع التصميم وقم بأختيار خصائص النموذج ومن ثم قم بعمل التنسيقات الخاصة بك من اختيار لون الخط ونوعه وحجمه ولون الخلفية وهل ترغب في ازالة محددات السجلات ام لا وكذلك اشرطة التمرير وزر تصغير وتكبير واغلاق . وتوسيط تلقائي وغيرها من الامور الغير خافية عليك . ( لا تخرج من وضع التصميم بل ابقه كما هو حسب تنسيقاتك المفضله )

6. انتقل الان الى قوائم الاكسيس العلوية واختر تنسيق ومنه اختر تنسيق تلقائي

7. من هذه اللوحة تختر خيارات وستظهر لك اسفل اللوحة ( الخط - اللون - الحد ) قم بالتأشير عليها جميعا .

8. اختر تخصيص

9. سيتم فتح مربع حوار تخصيص التنسيق التلقائي اختر منه الخيار الاول ( انشاء وتنسيق تلقائي جديد استنادا الى نموذج " اسم نموذج " ) ثم اضغط موافق .

10. سيظهر لك مربع حوار يطالبك بوضع اسم النمط

11. اكتب اسم النمط الخاص بك ثم موافق

12. ستشاهد النمط الخاص بك تم ادراجه من ضمن التنسيقات التلقائية للنماذج

13. قم بعمل عدة انماط خاصة بك واعطي كل نمط اسم مختلف

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

جميع هذه الانماط ستبقى ثابته وتستطيع استخدامها في اي وقت تشاء مالم تقم بحذف برنامج الاكسيس او تقوم بعمل تحديث له من السيدي روم الخاص بالاوفيس ( بمعنى تثبته من جديد ) .

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

أخوكم

جمال

السلام عليكم

هذا الكود يحول التاريخ الميلادي إلى هجري

ويجب ان يكون التطبيق كامل يعتمد التقويم الميلادي عن طريق أدوات - خيارات هناك خيار اتعتمد التاريخ الهجري يجب ان يكون غير نشط

Dim x As Date    
VBA.Calendar = vbCalGreg   
x = Me.DateTxt    
VBA.Calendar = vbCalHijri     
Me.Txt1.SetFocus         
Me.Txt1.Text = x

وهذا عكس للكود السابق اي يحول من الهجري إلى الميلادي وأيضا يجب أن يكون التطبيق يعتمد التقويم الهجري المجود قائمة ادوات - خيارات ( خيار أعتمد التاريخ الهجري يكون منشط)

VBA.Calendar = vbCalHijri
z = Me.Date
VBA.Calendar = vbCalGreg
Me.Txt1.SetFocus
Me.Txt1.Text = z

وشكرا

تبارك الله شباب

الأخت الأستاذه / زهرة واصلي العطاء أجزل الله لك لك العطاء يوم اللقاء مواضيعك شيقة .

أخي ولـwaleedـيد نعم إظهر وبان بارك الله في طرحك رائع بالتوفيق نتظر المزيد.

وين الباقين ها يا شباب ليش أرتفعت الأسهم ترون هذه الأسهم سعرها غير مربحة فوق ما تتصورون نريد من كل واحد أن يطرح ما في جعبته

مربع التحرير والسرد ComboBox

أثناء تصفحي الأنترنت قمت بالبحث في قوقل وبعد كتابتي كلمة البحث ظهرت رسالة ( هل تريد من .... تذكر هذه الكلمة) للبحث ثم بعد كتابة كل حرف تظهر لي الكلمات التي تبدأ بالحروف التي أكتبها وتتقلص القائمة وعند مسح حرف تقوم بالإتساع لتشمل بيانات أكثر وإذا أردت أن أحذف من تلك القائمة أتنقل بالأسهم إلى أن أصل إلى الكلمة التي أريد حذفها ثم أضغط على مفتاح Delete من لوحة المفاتيح فأعجبتني الفكرة فطبقتها على أكسيس .

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

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

كود إضافة عنصر لمربع التحرير والسرد

الطريقة :

1__ ننشيء جدول الوظائف ونسميه __ FrmJob

2__ننشي حقول الجدول وهي :

3__رقم الوظيفة ____ IDJob

4__اسم الوظيفة ____ JobName

5__ننشيء نموذج ونسميه أي اسم

6__ ننشيء مربع تحرير وسر ComboBox ونسيه CboJobName

7__ في حدث النموذج حدث ( عند الفتح ) نقوم بتحميل البيانات في مربع التحرير والسرد ComboBox بواسطة لغة إس كيو إل sql كما يلي:

Me.JobCbo.RowSource = "Select * From JobTbl"

8__ نذهب إلى خصائص مربع التحرير والسر ComboBox خاصية ( توسيع تلقائي ) ( Auto Expand ) ونضبطها على ( لا )

9__ نذهب لخاصية ( عند عدم الوجود في القائمة ) _( JobCbo_NotInList ) ونكتب الكورد التالي:

    If MsgBox("هذا البند غير مسجل في القائمة هل تريد إضافته", vbMsgBoxRight + vbInformation + vbYesNo + vbDefaultButton2, "") = vbNo Then
                Response = acDataErrContinue
        MsgBox "لقد تم إلغاء أمر الإضافة", vbMsgBoxRight + vbInformation, "إلغاء"

    Exit Sub
    Else
    
        Dim db As Database, rsCust As Recordset, strSQL As String
        Set db = CurrentDb
        
        strSQL = "select * from JobTbl"
        Set rsCust = db.OpenRecordset(strSQL, DB_OPEN_DYNASET)

        strSQL = "INSERT INTO JobTbl "
        strSQL = strSQL & "( JobName)"
        strSQL = strSQL & " Values ('"
        strSQL = strSQL & (Me!JobCbo.Text) & "');"
        
        db.Execute strSQL

        Response = acDataErrContinue
        
        MsgBox "لقد تم إضافة" & " (  " & Me.JobCbo.Text & "  )  " & " إلى عناصر القائمة بنجاح ", vbMsgBoxRight + vbInformation, "ãÈÑæß"
        
        Me.JobCbo = ""
        Me.JobCbo.Requery
        Me.JobCbo.SetFocus
                Me.JobCbo.RowSource = " Select * From JobTbl Where JobName Like '" & Me.JobCbo.Text & "*'ORDER BY JobName"

        Me.JobCbo.Dropdown

    End If

الآن نشرح الكود سطر سطر

السطر :

    If MsgBox("هذا البند غير مسجل في القائمة هل تريد إضافته", vbMsgBoxRight + vbInformation + vbYesNo + vbDefaultButton2, "") = vbNo Then

الشرح

مربع رسالة مشروطة نخبر المستخدم خلالها بأن ما كتبه ليس ضمن القائمة ونسأله هل يريد إضافته ونعرض زري أمر نعم و لا ونختبر خيارات المستخدم هل أختار زر نعم أم زر لا .

السطر :

 Response = acDataErrContinue

الشرح

إذا أختار المستخدم زر لا نوقف رسالة أكسيس الإفتراضية التي تظهر عند عدم الوجود في القائمة.

السطر.

        MsgBox "لقد تم إلغاء أمر الإضافة", vbMsgBoxRight + vbInformation, "إلغاء"

نخبر المستخدم بأنه تم إلغاء الأمر

السطر :أمر إيقاف تنفيذ ما بعده من أوامر

    Exit Sub

Else ما عدى ذلك أي إذا أختار المستخدم زر نعم

السطر :

        Dim db As Database, rsCust As Recordset, strSQL As String

Db متغير من نوع قواعد البيانات Database

rsCust متغير نوع بياناته سجلات جدول Recordset

strSQL متغير من نوع نص يخزن فيه البيانات المختارة من الجدول في جملة sql

السطر التالي : جعل قاعدة البيانات الحالية .

       Set db = CurrentDb

السطر التالي :

        strSQL = "select * from JobTbl"

نقوم بإختيار بيانات الجدول ونسندها إلى المتغير strSQL لكي نتعامل مع المتغير strSQL بدلاً من الجدول 0

السطر التالي :

  Set rsCust = db.OpenRecordset(strSQL, DB_OPEN_DYNASET)

نسند السجلات المخزنة في جملة strsql في المتغير rsCust

في السطر التالي نقوم بإضافة ما تم كتابته في مربع النص الخاص بمربع التحرير والسرد ComboBox الغير موجود ضمن القائمة.

       strSQL = "INSERT INTO JobTbl "
        strSQL = strSQL & "( JobName)"
        strSQL = strSQL & " Values ('"
        strSQL = strSQL & (Me!JobCbo.Text) & "');"

السطر التالي: أمر بمعنى نفذ أي قم بتشغيل لغة sql الخاصة بإضافة العنصر لمربع التحرير والسرد ComboBox

 db.Execute strSQL

السطر التالي : إيقاف رسالة أكسيس الأفتراضية

   Response = acDataErrContinue

السطر التالي : نخبر المستخدم بأنه تم إضافة العنصر

        MsgBox "لقد تم إضافة" & " (  " & Me.JobCbo.Text & "  )  " & " إلى عناصر القائمة بنجاح ", vbMsgBoxRight + vbInformation, "ãÈÑæß"

السطر التالي : نجعل مربع التحرير والسرد ComboBox فارغ .

       Me.JobCbo = ""

السطر التالي : نقوم بتحديث مربع التحرير والسرد ComboBox بالعنصر الجديد ليظهر ضمن عناصر مربع التحرير

       Me.JobCbo.Requery

السطر التالي : نقل التركيز إلى مربع التحرير والسرد ComboBox للإختيار منه

   Me.JobCbo.SetFocus

السطر التالي : نقوم بتزويد مربع التحرير والسرد ComboBox بمصدر بيانات عبارة عن لغة sql مشروطة بالحروف التي يكتبها المستخدم في مربع التحرير والسرد ComboBox ومع كل حرف لا يظهر في مربع التحرير والسرد ComboBox

سوى الوظائف التي تحتوي على تلك الحروف أيضاً نقوم بفرز تلك الوظائف أبجدياً مع كل حرف نكتبه.

                Me.JobCbo.RowSource = " Select * From JobTbl Where JobName Like '" & Me.JobCbo.Text & "*'ORDER BY JobName"

السطر التالي : أمر يجعل مربع التحرير والسرد ComboBox منسدلاً وننهي الشروط بكلمة End If

  Me.JobCbo.Dropdown

    End If

كود حذف عنصر من القائمة

ــــــــ

    If KeyCode = 46 Then
    If MsgBox("هل تريد فعلاً حذف هذا العنصر", vbMsgBoxRight + vbInformation + vbYesNo + vbDefaultButton2, "") = vbNo Then
        Response = acDataErrContinue    
    Exit Sub
    Else
        Dim db As Database, strSQL As String
        Set db = CurrentDb
            strSQL = "Delete * from JobTbl "
            strSQL = strSQL & " WHERE JobName='" & Me!JobCbo.Text & "'"
            db.Execute strSQL
            MsgBox "لقد تم حذف" & " (  " & Me.JobCbo.Text & "  )  " & " بنجاح ", vbMsgBoxRight + vbInformation, "مبروك"
            Me.JobCbo = ""
            Me.JobCbo.Requery
            Me.JobCbo.Dropdown

    End If
    End If



شرح الكود:
السطر التالي : شرط إذا ضغط المستخدم على زر Delete من لوحة المفاتيح أثناء أختياره عنصر من مربع التحرير والسرد ComboBox

 [CODE]   If KeyCode = 46 Then

السطر التالي : نسأل المستخدم هل يريد الحذف

    If MsgBox("هل تريد فعلاً حذف هذا العنصر", vbMsgBoxRight + vbInformation + vbYesNo + vbDefaultButton2, "") = vbNo Then

السطر التالي : إذا رفض الحذف نوقف رسالة أكسيس الأفتراضية ثم نخرج من الإجراء.

   Response = acDataErrContinue    
    Exit Sub
    Else

        Dim db As Database, strSQL As String

السطر السابق :

Db متغير من نوع قواعد البيانات Database

rsCust متغير نوع بياناته سجلات جدول Recordset

strSQL متغير من نوع نص يخزن فيه البيانات المختارة من الجدول في جملة sql

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

  Set db = CurrentDb
            strSQL = "Delete * from JobTbl "
            strSQL = strSQL & " WHERE JobName='" & Me!JobCbo.Text & "'"
            db.Execute strSQL
            MsgBox "لقد تم حذف" & " (  " & Me.JobCbo.Text & "  )  " & " بنجاح ", vbMsgBoxRight + vbInformation, "مبروك"
            Me.JobCbo = ""
            Me.JobCbo.Requery
            Me.JobCbo.Dropdown

    End If
    End If

ــــــــ

الكود التالي : يوضع في حدث مربع التحرير والسرد ComboBox حدث ( عند مفتاح لأعلى )

[CODE]     Select Case KeyCode
     Case 38
     Case 40
     Case 9
     Case 13
     Case 18
     Case 115

الأسطر السابقة : نقوم باختبار المفاتيح المضغوطة في لوحة المفاتيح فإذا كانت أح المفاتيح التالي : السهم لأعلى _ السهم لأسفل _

Tab_ Enter_Alt_F4

نخرج من الإجراء نخرج من الأجراء .

السبب : لا نريد التصفية عليها لأنها لا تحتوي على حروف ثم أن لها وظائف مع مربع التحرير والسرد ComboBox هامة ولا نريد إلغاء عملها الأساسي مثل : الأسم التنقل بين عناصر مربع التحرير والسرد ComboBox مفتاحي تاب وأنتر للخروج من مربع التحرير والسرد ComboBox مفتاحي Alt و F4 لسدل القائمة

Exit Sub

Case Else

السطر التالي : نجعل مصدر بيانات مربع التحرير والسرد ComboBox لغة Sql مشروطة بأول كل حرف يكتب في مربع النص الخاص بمربع التحرير والسرد ComboBox

Me.JobCbo.RowSource = " Select * From JobTbl Where JobName Like '" & Me.JobCbo.Text & "*'ORDER BY JobName"

If Me.JobCbo.Text <> "" Then

Me.JobCbo.Dropdown

End If

End Select

ملاحظة هامة جداً :

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

سوف أرفق مثال ولكن ليس قبل شهرين على أقل تقدير ليس أريد من الشباب أن يطبقوا بأنفسهم يحاولون يخطئون ويصيبون ((( هذا هو التعلم )))

اعزائي الكرام

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

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

هل فكر احدكم توسيط النص داخل عنصر تحكم ( سواء مربع تسميه او مربع نص ) سواء في النماذج او التقارير ولم ينجح ؟

السبب في ذلك ان شركة مايكروسوفت لم تقم بإدراج هذه الخاصية ضمن برنامج الاكسيس ولكنها موجوده في برنامج الوورد والاكسيل والفرونت بيج وهي خاصة بتوسيط النص داخل الخلية .

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

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

سنقوم الان بإستدعاء دالة التوسيط ونري النتيجة

هذه هي الدالة المسؤلة عن كود التوسيط

قم بعمل وحدة نمطية جديده وقم بنسخ هذه الكود بداخلها

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

Option Explicit

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Const LF_FACESIZE = 32

Private Type LOGFONT
        lfHeight As Long
        lfWidth As Long
        lfEscapement As Long
        lfOrientation As Long
        lfWeight As Long
        lfItalic As Byte
        lfUnderline As Byte
        lfStrikeOut As Byte
        lfCharSet As Byte
        lfOutPrecision As Byte
        lfClipPrecision As Byte
        lfQuality As Byte
        lfPitchAndFamily As Byte
        lfFaceName As String * LF_FACESIZE
End Type

Private Type TEXTMETRIC
        tmHeight As Long
        tmAscent As Long
        tmDescent As Long
        tmInternalLeading As Long
        tmExternalLeading As Long
        tmAveCharWidth As Long
        tmMaxCharWidth As Long
        tmWeight As Long
        tmOverhang As Long
        tmDigitizedAspectX As Long
        tmDigitizedAspectY As Long
        tmFirstChar As Byte
        tmLastChar As Byte
        tmDefaultChar As Byte
        tmBreakChar As Byte
        tmItalic As Byte
        tmUnderlined As Byte
        tmStruckOut As Byte
        tmPitchAndFamily As Byte
        tmCharSet As Byte
End Type

Private Declare Function GetTextMetrics Lib "gdi32" Alias "GetTextMetricsA" _
(ByVal hDC As Long, lpMetrics As TEXTMETRIC) As Long

Private Declare Function apiCreateFontIndirect Lib "gdi32" Alias _
        "CreateFontIndirectA" (lpLogFont As LOGFONT) As Long

Private Declare Function apiSelectObject Lib "gdi32" Alias "SelectObject" _
(ByVal hDC As Long, _
ByVal hObject As Long) As Long

Private Declare Function apiDeleteObject Lib "gdi32" _
  Alias "DeleteObject" (ByVal hObject As Long) As Long

Private Declare Function apiGetDeviceCaps Lib "gdi32" Alias "GetDeviceCaps" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long

Private Declare Function apiMulDiv Lib "kernel32" Alias "MulDiv" _
(ByVal nNumber As Long, _
ByVal nNumerator As Long, ByVal nDenominator As Long) As Long

Private Declare Function apiGetDC Lib "user32" _
  Alias "GetDC" (ByVal hwnd As Long) As Long

Private Declare Function apiReleaseDC Lib "user32" _
 Alias "ReleaseDC" (ByVal hwnd As Long, _
 ByVal hDC As Long) As Long

Private Declare Function apiDrawText Lib "user32" Alias "DrawTextA" _
(ByVal hDC As Long, ByVal lpStr As String, ByVal nCount As Long, _
lpRect As RECT, ByVal wFormat As Long) As Long

Private Declare Function CreateDCbyNum Lib "gdi32" Alias "CreateDCA" _
(ByVal lpDriverName As String, ByVal lpDeviceName As String, _
ByVal lpOutput As Long, ByVal lpInitData As Long) As Long  'DEVMODE) As Long

Private Declare Function apiDeleteDC Lib "gdi32" _
  Alias "DeleteDC" (ByVal hDC As Long) As Long

Declare Function GetProfileString Lib "kernel32" _
   Alias "GetProfileStringA" _
  (ByVal lpAppName As String, _
   ByVal lpKeyName As String, _
   ByVal lpDefault As String, _
   ByVal lpReturnedString As String, _
   ByVal nSize As Long) As Long

' محتويات الكود
Private Const TWIPSPERINCH = 1440
'  يستخدم لسؤال النظام في كل بكسل على المحور السيني والصادي
Private Const LOGPIXELSY = 90
Private Const LOGPIXELSX = 88

' يتم هنا معالجة النصوص
Private Const DT_TOP = &H0
Private Const DT_LEFT = &H0
Private Const DT_CALCRECT = &H400
Private Const DT_WORDBREAK = &H10
Private Const DT_EXTERNALLEADING = &H200
Private Const DT_EDITCONTROL = &H2000&
Private Const DT_NOCLIP = &H100

' خاص بالخطوط
Private Const OUT_DEFAULT_PRECIS = 0
Private Const OUT_STRING_PRECIS = 1
Private Const OUT_CHARACTER_PRECIS = 2
Private Const OUT_STROKE_PRECIS = 3
Private Const OUT_TT_PRECIS = 4
Private Const OUT_DEVICE_PRECIS = 5
Private Const OUT_RASTER_PRECIS = 6
Private Const OUT_TT_ONLY_PRECIS = 7
Private Const OUT_OUTLINE_PRECIS = 8

Private Const CLIP_DEFAULT_PRECIS = 0
Private Const CLIP_CHARACTER_PRECIS = 1
Private Const CLIP_STROKE_PRECIS = 2
Private Const CLIP_MASK = &HF
Private Const CLIP_LH_ANGLES = 16
Private Const CLIP_TT_ALWAYS = 32
Private Const CLIP_EMBEDDED = 128

Private Const DEFAULT_QUALITY = 0
Private Const DRAFT_QUALITY = 1
Private Const PROOF_QUALITY = 2

Private Const DEFAULT_PITCH = 0
Private Const FIXED_PITCH = 1
Private Const VARIABLE_PITCH = 2

Private Const ANSI_CHARSET = 0
Private Const DEFAULT_CHARSET = 1
Private Const SYMBOL_CHARSET = 2
Private Const SHIFTJIS_CHARSET = 128
Private Const HANGEUL_CHARSET = 129
Private Const CHINESEBIG5_CHARSET = 136
Private Const OEM_CHARSET = 255
'

Public Function fTextHeight(ctl As Control, _
Optional ByVal sText As String = "", _
Optional HeightTwips As Long = 0, Optional WidthTwips As Long = 0, _
Optional TotalLines As Long = 0, _
Optional TwipsPerPixel As Long = 0) As Long On Error Resume Next

' يتم هنا استداعاء الدالة لمعالجة ارتفاع النص
' اذا كان ارتفاع النص صحيحا في عنصر التحكم اذن تتم المعالجة للارتفاع
fTextHeight = fTextWidthOrHeight(ctl, True, _
sText, HeightTwips, WidthTwips, TotalLines, TwipsPerPixel)

End Function


Public Function fTextWidth(ctl As Control, _
Optional ByVal sText As String = "", _
Optional HeightTwips As Long = 0, Optional WidthTwips As Long = 0, _
Optional TotalLines As Long = 0, _
Optional TwipsPerPixel As Long = 0) As Long On Error Resume Next

' اذا كان ارتفاع النص غير صحيح فتتم المعالجة للعرض
' يتم هنا استدعاء الدالة لمعالجة عرض النص
fTextWidth = fTextWidthOrHeight(ctl, False, _
sText, HeightTwips, WidthTwips, TotalLines, TwipsPerPixel)

End Function


 Public Function fTextWidthOrHeight(ctl As Control, ByVal blWH As Boolean, _
 Optional ByVal sText As String = "", _
 Optional HeightTwips As Long = 0, Optional WidthTwips As Long = 0, _
 Optional TotalLines As Long = 0, _
 Optional TwipsPerPixel As Long = 0) As Long

 Dim sRect As RECT
 Dim hDC As Long
 Dim lngDPI As Long
 Dim newfont As Long
 Dim oldfont As Long
 Dim lngRet As Long
 Dim myfont As LOGFONT
 Dim tm As TEXTMETRIC
 Dim lngLineSpacing As Long
 Dim numLines As Long
 Dim strName As String
 Dim sngTemp1 As Single
 Dim sngTemp2 As Single On Error GoTo Err_Handler

If TypeOf ctl.Parent Is Access.Report Then
    strName = GetDefaultPrintersName
    hDC = CreateDCbyNum("WINSPOOL", strName, 0&, 0&)
    If hDC = 0 Then
        Err.Raise vbObjectError + 255, "fTextWidthOrHeight", "Cannot Create Printer DC"
    End If

Else
   hDC = apiGetDC(0&)
End If

    If Len(sText & vbNullString) = 0 Then
    Select Case ctl.ControlType
         Case acTextBox
         sText = Nz(ctl.Value, vbNullString)

         Case acLabel, acCommandButton
         sText = Nz(ctl.Caption, vbNullString)

         Case acListBox
         sText = Nz(ctl.ItemData(0), vbNullString)

         Case Else
         fTextWidthOrHeight = 0
         Exit Function
     End Select
 End If

 If blWH Then
     lngDPI = apiGetDeviceCaps(hDC, LOGPIXELSY)
 Else
     lngDPI = apiGetDeviceCaps(hDC, LOGPIXELSX)
 End If

TwipsPerPixel = TWIPSPERINCH / lngDPI
 With ctl
     myfont.lfClipPrecision = CLIP_LH_ANGLES
     myfont.lfOutPrecision = 0
     myfont.lfEscapement = 0
     myfont.lfFaceName = .FontName & Chr$(0)
     myfont.lfWeight = .FontWeight
     myfont.lfItalic = .FontItalic
     myfont.lfUnderline = .FontUnderline
     myfont.lfHeight = (.FontSize / 72) * -lngDPI
     newfont = apiCreateFontIndirect(myfont)
 End With

     If newfont = 0 Then
         Err.Raise vbObjectError + 256, "fTextWidthOrHeight", "Cannot Create Font"
     End If

 oldfont = apiSelectObject(hDC, newfont)
 With sRect
   .Left = 0
   .Top = 0
   .Bottom = 0

   If blWH Then
     .Right = (ctl.Width / (TWIPSPERINCH / lngDPI)) - 10
   Else
     .Right = 32000
   End If

   lngRet = apiDrawText(hDC, sText, -1, sRect, DT_CALCRECT Or DT_TOP Or _
   DT_LEFT Or DT_WORDBREAK Or DT_NOCLIP)
   lngRet = GetTextMetrics(hDC, tm)
   lngRet = apiSelectObject(hDC, oldfont)
   apiDeleteObject (newfont)

  If TypeOf ctl.Parent Is Access.Report Then
     lngRet = apiDeleteDC(hDC)

  Else
    lngRet = apiReleaseDC(0&, hDC)
  End If

 TotalLines = .Bottom / (tm.tmHeight + tm.tmExternalLeading)
 numLines = TotalLines
 .Bottom = (.Bottom) * (TWIPSPERINCH / lngDPI)
 HeightTwips = .Bottom
   WidthTwips = .Right * (TWIPSPERINCH / lngDPI)

   If blWH Then
     fTextWidthOrHeight = HeightTwips
   Else
    fTextWidthOrHeight = WidthTwips
   End If
End With

Exit_OK:
Exit Function

Err_Handler:
Err.Raise Err.Source, Err.Number, Err.Description
Resume Exit_OK
End Function

Function GetDefaultPrintersName() As String
' هنا يتم استدعاء الطابعة الافتراضية
'وجعلها تقبل القيم الجديده المعدلة في التقرير
' بدون هذا الكود سيطبع التقرير بدون توسيط للحقول
Dim success As Long
Dim nSize As Long
Dim lpKeyName As String
Dim ret As String
Dim posDriver
ret = Space$(8102)
nSize = Len(ret)
success = GetProfileString("windows", "device", "", ret, nSize)
posDriver = InStr(ret, ",")
GetDefaultPrintersName = Left$(ret, posDriver - 1)
End Function

Public Function ScreenTwipsPerPixel() As Long
Dim hDC As Long
Dim lngRet As Long
' في هذا الكود تم معالجة بعض اخطاء الطابعات
' التي بجب ان تطبع ما هو موجود على الشاشة وبنفس التنسيق 
    hDC = apiGetDC(0&)
    ScreenTwipsPerPixel = TWIPSPERINCH / apiGetDeviceCaps(hDC, LOGPIXELSY)
    'هنا كود التحرير من الكود السابق
    lngRet = apiReleaseDC(0&, hDC)
End Function

ستجد الشرح الكامل موجود في كود الدالة وكذلك في النموذج والتقرير

وهذا مثال مرفق لكل العملية

In_TheMiddle.rar

استاذنا ومعلمنا مصلح الحريصي

ما شاء الله عليك قمة في الروعة والابداع

تم تطبيق الجزء الاول من الكود ويعمل بشكل رائع

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

اشرت في مشاركتك الى

اقتباس

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

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

عند فتح النموذج لن ترى الزر بل سترى مستطيل ابيض وعند النقر داخل المستطيل سيظهر الزر وعند الخروج من المستطيل سيختفي الزر . صار لغز يحتاج الى حل :) :)

اين يكمن السر يازهره :) :)

Mr_M_Haresy.rar

الأستاذة / زهرة

بارك الله فيك

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

في VB6 و VB.Net هناك إمكانية لعمل ذلك فقلت في نفسي لعل مربع التحرير في أكسيس ورث تلك الصفة من أبوه VB ولم أعرفها.

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

ولذلك أنا طلبت في نهاية المشاركة الإطلاع والتصحيح لأنني قد أغفل عن بعض الأشياء واجعل المتابع يتوه في دوامة .

شكراً لك

وهذا مثال على ما سبق حتى تتضح الرؤيا

(( المسلم مرآة أخيه المسلم ))

ComboBox.rar

(((((( إبــــــــــــــــــــــــــــــــــــــ(أحمد)ــ و ــ(زهره)ــ وــ(مصلح)ــــــــــــــــــــــــــــــــــــــــــــداع ))))

تحياتي ..

كثيرون يملكون المعرفة ، ولكن قلة هم الكرماء الذين يبذلون مايعرفون للآخرين ،، شكراً لكم شكراً لكم .

إدخال بيانات إجبارية

في مثالنا التالي سنستبدل ( Msgbox ) صندوق الرسائل برسالة خاصة نستخدم فيها الألوان والإشارات إلى الحقول الفارغة والمطلوب تعبئتها.

أولاً سنحضر صورة صغيرة لسهم ثم نضعها على نموذج إدخال البيانات في أي مكان من النموذج ونسميها ( P1 ) ثم نجعل خاصية مرئي لهذه الصورة = لا أي Visible = False

ثم نضع في خاصية ( Tag ) وترجمتها ( علامة) أي اسم نريد هنا وضعت أسمي ( Musleh )

في وحدة نمطيه على مستوى النموذج نكتب الكود التالي : ووظيفته المرور على مربعات النصوص فإذا وجد إحدى مربعات النصوص التي تحتوي في خاصية Tag على كلمة Musleh فارغة يقوم بتلوينها باللون الأحمر ولون الخط باللون الأبيض ثم يظهر سهم يشير إليها وهذا السهم هنا عبارة عن صورة اسميتها P1 .

Private Sub BackColorTrue()
    Dim Ct As Control
    For Each Ct In Me
        If Ct.Tag = "Musleh" Then
        If IsNull(Ct) Or Ct = "" Then
        
           Ct.SetFocus
           Ct.BackColor = 255
           Ct.ForeColor = 16777215
           Me.P1.Left = Ct.Left - 550
           Me.P1.Top = Ct.Top - 10
            Me.TimerInterval = 300
           Exit Sub
        
    End If
    End If
    Next Ct

End Sub

ثم نكتب دالة أخرى وظيفتها عكس السابقة. وهي إعادة لون خلفية مربع النص ولون الخط إلى وضعه الطبيعي بعد تعبئته بالبيانات والشفرة هي التالية :

Private Sub BackColorFalse()
    Dim Ct As Control
    For Each Ct In Me
        If Ct.Tag = "Musleh" Then
        If Ct.BackColor = 255 Then
           Ct.BackColor = 16777215
           Ct.ForeColor = 0
            Me.TimerInterval = 0
            Me.P1.Visible = False
           Exit Sub
        
    End If
    End If
    Next Ct

End Sub

ثم في حدث مربعات النصوص المطلوبة حدث ( بعد التحديث) نستدعي الدالة التي تعيد لون خلفية وخط مربع النص لوضعه الطبيعي كما يلي :

Call BackColorFalse

في حدث زر ( حفظ ) نستدعي الدالة المسؤولة عن تلوين الخلفية والخط كما يلي :

 Call BackColorTrue

جرب ترك أحد الحقول فارغاً ثم أضغط زر حفظ وشاهد ثم قم بتعبئة الحقل بالبيانات وأضغط مفتاح Enter أو Tab

وهذا مثال مرفق

Example.rar

بوركتم وباركتم

جزاكم الله كل الخير

وزادكم من علمه الذي لا ينضب ابدا

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

تحياتي للجميع .................

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

والله يرعاكم والى الامام يااساتذتنا

ما شاء الله على هاخرابيش

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

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

سلام وفقكم الله وجزاكم الف خير

هل فكر احدنا من اين تأتي رسائل الخطأ ومن اين تأتي هذه الارقام الخاصة بها وكيف يمكن تعديلها بناء على رغباتنا بدلا من تقييدنا برسائل اخطاء الاكسيس الغير معبره . ان المسئول عن هذه الرسائل هو محرك تعريف لغة البيانات Jet 4.0 اذن دعونا نقوم بإنتاج هذه الرسائل برمجيا في جدول معتمدين على دالة توليد الاخطاء حسب الطريقة التالية

اولا : انشاء جدول جديد وسنجعل اسمه مثلا tblErrors ( جدول الاخطاء ) ويحتوي الحقول التالية :

1. اسم الحقل الاول : رقم الخطأ

Field Name: ErrorNumber

نوع البيانات : رقم

Data Type: Number

مفهرس : لا

Indexed: No

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

Primary Key: No

2. اسم الحقل الثاني : وصف الخطأ

Field Name: ErrorDescription

نوع البيانات : مذكرة

Data Type: Memo

بعد انشاء الجدول نحفظه كما اتفقنا بإسم tblErrors ثم نغلق الجدول

ثانيا : انشاء وحدة نمطية جديده module ونضع بها هذا الكود

Function sRecordAccessErrorMsg()
Dim ADOcnn As ADODB.Connection
Dim ADOrst As ADODB.Recordset
Dim intCounter As Long
Dim intErrornumber As Long
Dim strErrorText As String
Set ADOcnn = CurrentProject.Connection
Set ADOrst = New ADODB.Recordset
ADOrst.Open "tblErrors", ADOcnn, adOpenDynamic, adLockOptimistic
With ADOrst
    For intCounter = 0 To 32767
        .AddNew
        !ErrorNumber = intCounter
        If IsNull(AccessError(intCounter)) Then
            !ErrorDescription = "No Error"
        ElseIf AccessError(intCounter) = "" Then
            !ErrorDescription = "No Error"
        Else
            !ErrorDescription = AccessError(intCounter)
        End If
        .Update
    Next intCounter
End With
MsgBox "مبروك : تم انشاء رسائل الاخطاء في الجدول"
End Function

لو نلاحظ هذا الكود انه يعتمد على ADODB من خلال العمليات التي يقوم بها وهي

1. إنشاء سجلات جديده

Set ADOrst = New ADODB.Recordset

2. يقوم بعد السجلات من 0 - 32767 وهي اخر رقم في رسائل الاكسيس التي تظهر لنا دائما

For intCounter = 0 To 32767

وكما يعلم الجميع ان الارقام المحصورة بين 0 - 32767 ليست كلها رسائل اخطاء والا لقرأنا على برنامج الاكسيس السلام ولكن هناك الكثير من الارقام الفارغة بدون رسائل وطبعا لا يمكن انتقاءها الا بعد انشاء الجدول والغاؤها والابقاء على الارقام المحتويه على اخطاء فقط

3. قم بحفظ الوحدة النمطية Module1

4. سنقوم الان بإنشاء نموذج وعليه زر امر وعند حدث النقر على زر الامر نضع هذا الكود الذي يستدعي الدالة السابقة

Call sRecordAccessErrorMsg

5. مالذي سيحدث عند النقر على الزر السابق

ستقوم الدالة بإنشاء السجلات من 0 - 32767 في الجدول السابق ومعها رسائل الاخطاء الفارغة التي تحمل العبارة NO Error ومجموعها 28488 وكذلك الاخطاء المبهمة والتي تحمل العبارة Application-defined or object-defined error والتي مجموعها 1911 وبحسبة بسيطة نستطيع معرفة رسائل الاخطاء الصحيحة كما يلي

عدد الاخطاء 32767

الاخطاء الفارغة 2848 ( NO Error )

الاخطاء المبهمة Application-defined or object-defined error 1911

32767 - ( 28488 + 1991 ) = 2368

6. وبما اننا لا نريد هذه السجلات التي لا تحوي على اخطاء فسنقوم بحذفها بواسطة استعلام حذف

DoCmd.RunSQL "DELETE tblErrors.ErrorNumber,tblErrors.ErrorDescription FROM tblErrors WHERE (((tblErrors.ErrorDescription)=""No Error"" OR (tblErrors.ErrorDescription)=""Application-defined or object-defined error"" ));"

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

1. استدعاء الدالة المسئوله عن انتاج الاخطاء ووضعها في الجدول

2. انشاء استعلام حذف السجلات التي تحوي على عبارة No Error او Application-defined or object-defined error

3. نقوم بعرض الجدول

4. لذا رغبنا في انشاء تقرير مبني على الجدول فلا يمنع ذلك

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

وهذا مثال على هذه العملية

ErrorMsg.rar

إيه يا أستاذ مصلح ، إظهر وبان وعليك الأمان

أما أستاذتنا زهرة ، فمعروفة لدى الجميع بإمكانياتها المذهلة

بالنسبة لي غبت لأجل اختبارات الأبناء ، وسأغيب ( ضعيف وقوي عين ) في الإجازة بسبب السفر ، وبعدها نعود بمشيئة الله

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

أشوف أستاذنا فهد الدوسري يخفي ما في خزانته من الإبداع ، فعليكم به يا رجال ، واستخرجوا ما في جعبته

دمت بخير ورضا

اعزائي الكرام

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

كعادتي دائما اقوم بترتيب وتنظيف جهاز الكمبيوتر لدي واستوقفني مثال يحمل العنوان HHHHH فأنا لا اذكر انني قد حملت هذا المثال لاني اقوم بإعادة تسمية الملفات بما اراه مناسب لاسم الملف فقلت في نفسي ماذا يكون هذا الملف وبدأت تساورني الشكوك فقررت الاطلاع عليه ومعرفة ما يخبئ لنا هذا المثال .

لقد اصبت بالدهشة حينما رأيت المثال انه من عمل العبقري استاذي فهد الدوسري ولكن ماذا يحمل هذا الملف من معنى وما هي الرسالة التي يود ايصالها .

وجدت شرحا على المثال " طريقة تحويل زر الماوس الى يد عند الضغط على الزر"

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

فتحت النموذج في وضع التصميم وبحثت عن الكود ولم اجد شيئا :lol:

قلت بالتأكيد انه ماكرو تم صنعه لهذه العملية وايضا لم اجد شيئا :lol:

قلت قد يكون دالة عامة في وحدة نمطية بحثت ولم اجد شيئا ايضا :lol:

قلت لالالالا المسألة فيها ذكاء وعبقريه وخارجه عن السيطره ولابد ان يكون هناك شبئ مخفي لا يمكن رؤيته ولكن اين يكمن السر اخيرا تذكرت ان الارتباط التشعبي ايضا يمكن استخدامه لمثل هذه العملية ( على مين يا فهد )

عند هذه النقطه عجزت عن التفكير بعد مشاهدة ان الارتباط التشعبي ايضا لا يوجد به شيئ :blink: :lol:

وبعدين معاك يافهد حتى اخر امل قمت بقطعه ولم تعطينا الاجابه :angry:

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

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

في نهاية اليوم الثاني قلت لابد من سؤال الاخ فهد كيف استطاع ان يقوم بهذه العملية المخفيه بدون كود ولا ماكرو ولا داله ولكنه العناد الذي ركب رأسي ان اكتشف هذا بنفسي :wacko:

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

المفاجأة

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

اخي فهد الدوسري انا ابصم لك بالعشرة واقر واعترف انك عبقري

الملف المرفق

HHHHH.rar

اختكم التي تبهذلت يومين تبحث عن حل اللغز

زهره

أولاً : أشكر أستاذي أحمد .. ويا أستاذي ترى ( الإبداع بعيد عني ) ولكني أحاول اللحاق به .

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

ثالثاً : لمن أراد عمل يد على زر الأمر في أي نموذج فليطبق الآتي :

1-نقوم بإدراج زر أمر ( بدون حدث ) أو ( بحدث ) كإغلاق نموذج أو فتح نموذج أو حفظ .

2-من خصائص الزر نذهب إلى (تنسيق) ثم ( عنوان الارتباط التشعبي) كما هو موضح في الصور التي وضعتها الأستاذة زهره .

3- من لوحة المفاتيح نضغط على ( المسطرة )مرة واحدة ليتم إنشاء عنوان ارتباط تشعبي (مخفي) .

4- نقوم بحفظ العمل .

5-عند الاقتراب من الزر سوف يتحول مؤشر الفأرة من (سهم)إلى (يد) كما هو الحال في صفحات الإنترنت .

أرجو أن تكون هذه المعلومة مفيدة للجميع .

تحياتي ..

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

اشكركم جميعا

استا ذ / فهد الدوسري

استاذة / زهرة

استاذ / احمد الحربي

استاذ / مصلح الحريصي

-waf

شوف استاذ فهد

ما ينفعك التملص أصلاً صدناك من زمان تقول ما تعرف _ بعيد عن العبقرية _ متعلم في البداية _ ما تعرف شيء هذا ما يمشي علينا يا عم دور الك منفذ أخر لأن الشواهد في طيات المنتديات فكيف تمسحها (( إلحق أحذف مثال أحذف رد )) والله يبغى لك سنين .

أقول لك شيء ولا يسمعنا أحد

ولا بلاش

أتمنى لك الرقي والسمو

يعني مصمم أستاذي مصلح أني ممكن أكون في مستواكم ( على راحتك ) .

عموماً هذه شهادات أعتز بها من خبراء الأكسس أمثالك وأمثال الأستاذه زهره والأستاذ أحمد .

وقول يا أستاذي مصلح ماراح أحد يسمعنا أبد ( يمكن يشوفونا بس ) .

تحياتي ..

طيب يا أستاذ فهد على رأسي

عرض مثيل من النموذج

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

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

Public CollectForms As New Collection

وفائدة هذا المتغير هو إبقاء النافذة ظاهرة على الشاشة فبدونه سوف تظهر Form ثم تختفي.

السطر التالي :

 Dim Frm As Form

إعلان عن متغير اسمه Frm وهو من نوع نموذج Form

السطر التالي : إنشاء النسخة ونحدد النموذج الذي ننسخه وهو هنا Frm5

 Set Frm = New Form_Frm5

السطر التالي : لجعل خاصية الإخفاء للنموذج " إظهار "

   Frm.Visible = True

السطر التالي : هو إضافة النسخة أو الشبيه إلى النماذج

 CollectForms.Add Frm

وهذا الكود كاملاً:

Public CollectForms As New Collection

 Dim Frm As Form
 Set Frm = New Form_Frm5
   Frm.Visible = True
 CollectForms.Add Frm

ضع تعريف المتغير المسمى CollectForms في أعلى الوحدة النمطية للنموذج

ثم الأسطر الباقية ضعها على زر أمر ثم أضغط على النموذج وشاهد النتيجة.

وللتذكير :

في السطر :Set Frm = New Form_Frm5

بعد كتابة كلمة New سوف تظهر لك قائمة بالنماذج لموجودة في قاعدة البيانات أختر النموذج الذي تريد إنشاء له شبيه

الاتصال بقواعد البيانات والتعامل مع ما تحتويه من بيانات:

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

1. إنشاء الجداول في نفس قاعدة البيانات _ وهذا الطريقة لا تحتاج مجهود من المبرمج في التعامل مع البيانات لأنه يسهل الاتصال بالبيانات0

2. إنشاء واجهة البرنامج وإنشاء قاعدة البيانات منفصلة عن الواجهة ويتم التعامل مع البيانات عن طريق ربط الجداول بحيث أنك ستشاهد اختصارات الجداول في قاعدة البيانات الواجهة وهذا الطريقة ليست متعبة أيضاً ولا تكلف المبرمج سوى كتابة كود ربط الجداول ثم التعامل مع البيانات وكأن الجداول في نفس قاعة الواجهة0

3. إنشاء واجهة البرنامج وإنشاء قاعدة البيانات منفصلة عن الواجهة ويتم التعامل مع البيانات عن طريق الكود وفي هذا الحالة يتم الاتصال بقاعدة البيانات والتعامل مع البيانات بواسطة أدوات الاتصال بقواعد البيانات والتي هي :( ADO _ DAO _ Sql ( وهذه الطريقة تختلف عن سابقتها حيث أنك تقوم بالاتصال بقواعد البيانات والتعامل مع البيانات بدون أن تكون الجداول في نفس قاعدة الواجهة أو يكون للجداول اختصارات في قاعدة الواجهة وهذه الطريقة صعبة على المبرمجة حيث يقوم بكتابة اكواد بشكل كبير على سبيل المثال : الاتصال بواسطة Sql

سيحتاج إلى إنشاء متغير لقاعدة البيانات ثم فتحها في الذاكرة ثم إنشاء لغة إس كيو إل Sql ثم إنشاء متغير من نوع جدول إسناد البيانات إلى الجدول ثم التعامل مع البيانات من خلال الكود من حيث ( الإضافة والتعديل والبحث والحذف ) وكل العمليات التي تتم على البيانات 0

بالنسبة لي أنا أفضل الطريقة الأخيرة رقم ( 3 ) وخصوصاً (( Sql )) مع أنها متعبة للمبرمج إلا أنك تجد فيها المتعة حيث يمكنك التلاعب بالبيانات كما يحلو لك وكما يخطر ببالك كما أنك لا تجد في قاعدة الواجهة أي جدول أو استعلام هذه الطريق إلا أن هذه الطريقة كما اسلفت متعبة وتحتاج إلى وقت في عمل أي برنامج كما أنه تتطلب منك الإحاطة بهذا الجانب 0

...........................................

اليوم سنتعرف على مثال بسيط على الطريقة الثالثة (Sql ) حيث سنقوم بإنشاء قاعدتين الأولى تحتوي على الجداول فقط والثانية على واجهة البرنامج ثم نقوم بالاتصال بقاعدة البيانات التي تحتوي على الجداول ونتعامل مع البيانات من خلال الواجهة ونقوم بالإضافة والتعديل والبحث والحذف .

أولاً : نقوم بإنشاء قاعدة خاصة بالجداول ونسميها : EmployeesData ونضيف إليها جدول ونسميه مثلاً Employees يحتوي على الحقول التالية :

1. رقم الموظف _____ EmpNo

2. اسم الموظف _____ EmpName

3. رقم هاتفه _____ EmpTel

4. المدينة _____ EmpCity

ونقوم بإنشاء قاعدة الواجهة ونسميها : EnterFace ونضيف نموذج ونسميه : EmployeesFrm ثم نضيف إليه مربعات النصوص التالية :

1. رقم الموظف _____ TxtEmpNo

2. اسم الموظف _____ TxtEmpName

3. رقم هاتفه _____ TxtEmpTel

4. المدينة _____ TxtEmpCity

ثم نضيف أزرار الأوامر التالية :

1. الحفظ _____ cmdSave

2. التحديث _____ cmdUpDate

3. بحث _____ CmdSearch

4. حذف _____ cmdDeleteRc

5. جديد _____ NRecord

الآن ننشيء وحدة نمطية عامة Module ونسميها في إطار قاعدة البيانات أي اسم وفي صفحة الكود لتلك الوحدة النمطية :

أولاً نعلن عن ثلاث متغيرات عمومية نستطيع استدعاءه من أي مكان في البرنامج وذلك كما يلي

Public MyDatabase As Database
Public MySQL As String
Public MyTable As Recordset

الأول : خاص اسمه (MyDatabase ) بقاعدة البيانات

الثاني : اسمه (MySQL ) خاصة بلغة Sql

الثالث : اسمه (MyTable ) خاص بالسجلات

ثم نكتب الكود التالي :

Public Sub Opdatabase()
1  Dim ProgramPath As String
2  ProgramPath = (Application.CodeProject.Path & "\EmployeesData.mdb")
3  Set MyDatabase = OpenDatabase(ProgramPath)
End Sub

لاحظ أن الأسطر مرقمة وتلك الأرقم ليست ضمن الكود وإنما للشرح فقط فلا تكتبها عندما تكتب هذا الكود.

أعلنا هنا عن متغير أسمينها (ProgramPath ) نخزن فيه مسار القاعدة التي تحتوي على الجداول المراد فتحها . ويجب أن تكون تلك القاعدة في نفس مجلد البرنامج وإلا نحدد مسار القاعدة كاملاً في الكود وخصوصاً عندما تكون على سيرفر.

نسند مسار القاعدة للمتغير كما في السطر رقم ( 2 ) ثم نفتح قاعدة البيانات في الذاكرة بواسطة سطر الأمر رقم ( 3 ) .

الآن نحن متصلين بقاعدة بيانات الجداول ويمكننا التعامل مع الجداول والبيانات نذهب إلى النموذج وتحديداً زر الحفظ وفي حدث عند النقر في الوحدة النمطية الخاصة بهذا الحدث نكتب الكود التالي :

Opdatabase

    MySQL = "INSERT INTO Employees "
    MySQL = MySQL & "(EmpNo,"
    MySQL = MySQL & "EmpName,"
    MySQL = MySQL & "EmpTel,"
    MySQL = MySQL & "EmpCity)"
    MySQL = MySQL & " values ("

    MySQL = MySQL & Me!TxtEmpNo & ",'"
    MySQL = MySQL & Me!TxtEmpName & "','"
    MySQL = MySQL & Me!TxtEmpTel & "','"
    MySQL = MySQL & Me!TxtEmpCity & "');"
    MyDatabase.Execute MySQL
MyTable.Clone
MyDatabase.Close

في السطر رقم ( 1 ) قمنا باستدعاء الوحدة النمطية العامة والخاصة بفتح قاعدة الجداول وهيئنا المتغيرين الخاصين بلغة Sql والسجلات.

في الأسطر من ( 2 _ 6 ) قمنا بتحديد الحقول التي نريد إضافة القيم إليها في الجدول .

في الأسطر من (7 _ 10 ) حددنا القيم التي نريد إضافتها إلى الجدول وذلك بتحديد قيم مربعات والسطر ما قبل الأخيرين هو بمعنى نفذ محتوى الشفرة البرمجية أو ( الكود ) ويبقى السطرين الأخيرين وهما إغلاق قاعدة بيانات الجداول والجدول حتى لا نسبب إزعاج للذاكرة فتزعل علينا.

....................................................

إلى هنا نتوقف لأنني تعبت اليوم.

من راق له لموضوع فليجرب ما سبق وسوف نواصل ما تبقى والموضوع طويل جداً ولكل هنا خبراء فليعلقوا بما لديهم من أراء واقتراحات وخبرات في هذا المجال لتعم الفائدة وأنا أول المستفيدين ولأجر لو تعلمون كبير.

تمنياتي للجميع دوام التوفيق

أستاذي مصلح .. أتمنى أن يتوج هذا الشرح الرائع ( بمثال رائع ) كما عهدنا ذلك منكم وحتى تكون الفائدة أكبر .

مع الشكر الجزيل لكل من تعب من أجل إيصال معلومة مفيده لغيره .

تحياتي ..