أحمد الحربي

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

82 ردود في هذا الموضوع

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

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

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

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

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

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

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

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

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

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

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

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

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

اخي ابو وليد

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

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

انماط جديدة من صنع يديك

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

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

18_01_06_12_50_42_11376174421.gif

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

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

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

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

18_01_06_12_51_31_1137617491_.gif

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

18_01_06_12_52_07_11376175273.gif

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

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

8. اختر تخصيص

18_01_06_12_52_44_11376175644.gif

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

18_01_06_12_53_23_11376176035.gif

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

18_01_06_12_54_08_11376176486.gif

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

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

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

18_01_06_12_54_46_11376176867.gif

18_01_06_12_55_33_11376177338.gif

18_01_06_12_56_15_11376177759.gif

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

18_01_06_12_56_49_113761780919.gif

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

تم تعديل بواسطه zahrah
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

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

أخوكم

جمال

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

السلام عليكم

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

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

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

وشكرا

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

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

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

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

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

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

مربع التحرير والسرد 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

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

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

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

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

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

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

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

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

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

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

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

27_01_06_06_34_26_1138415666befor.gif

27_01_06_06_35_23_1138415723befor_.gif

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

27_01_06_06_28_40_1138415320after.gif

27_01_06_06_29_42_1138415382after_.gif

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

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

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

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

1

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

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

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

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

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

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

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

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

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

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

Mr_M_Haresy.rar

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

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

بارك الله فيك

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

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

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

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

شكراً لك

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

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

ComboBox.rar

تم تعديل بواسطه مصلح الحريصي
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

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

تحياتي ..

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

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

تم تعديل بواسطه عبدالله سليمان2
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

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

في مثالنا التالي سنستبدل ( 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

تم تعديل بواسطه مصلح الحريصي
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

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

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

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

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

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

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

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

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

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

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

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

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

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

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

اصنع رسائل الخطأ في برنامج الاكسيس بنفسك

هل فكر احدنا من اين تأتي رسائل الخطأ ومن اين تأتي هذه الارقام الخاصة بها وكيف يمكن تعديلها بناء على رغباتنا بدلا من تقييدنا برسائل اخطاء الاكسيس الغير معبره . ان المسئول عن هذه الرسائل هو محرك تعريف لغة البيانات 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

تم تعديل بواسطه zahrah
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

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

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

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

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

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

دمت بخير ورضا

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

اكتشاف سر يد العبقري فهد الدوسري

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

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

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

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

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

01_02_06_10_06_27_1138860387F1.gif

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

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

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

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

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

01_02_06_10_15_55_1138860955F_.gif

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

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

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

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

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

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

01_02_06_10_46_54_1138862814F3.gif

المفاجأة

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

01_02_06_10_38_14_1138862294F4.gif

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

الملف المرفق

HHHHH.rar

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

زهره

تم تعديل بواسطه zahrah
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

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

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

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

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

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

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

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

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

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

تحياتي ..

تم تعديل بواسطه فهد الدوسري
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

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

اشكركم جميعا

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

استاذة / زهرة

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

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

-waf

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

شوف استاذ فهد

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

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

ولا بلاش

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

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

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

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

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

تحياتي ..

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

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

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

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

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

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 سوف تظهر لك قائمة بالنماذج لموجودة في قاعدة البيانات أختر النموذج الذي تريد إنشاء له شبيه

تم تعديل بواسطه مصلح الحريصي
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

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

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

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 ) حددنا القيم التي نريد إضافتها إلى الجدول وذلك بتحديد قيم مربعات والسطر ما قبل الأخيرين هو بمعنى نفذ محتوى الشفرة البرمجية أو ( الكود ) ويبقى السطرين الأخيرين وهما إغلاق قاعدة بيانات الجداول والجدول حتى لا نسبب إزعاج للذاكرة فتزعل علينا.

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

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

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

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

تم تعديل بواسطه مصلح الحريصي
0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

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

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

تحياتي ..

0

شارك هذا الرد


رابط المشاركة
شارك الرد من خلال المواقع ادناه

  • يستعرض القسم حالياً   0 members

    لا يوجد أعضاء مسجلين يشاهدون هذه الصفحة .