كشكول VBA ... متجدد

[أبو آدم]

إخوتي الأعزاء

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

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

وهذا كشكول ...

ندون به ما يمر بالخاطر ... فكرة راودتي من رد لأخي ورفيق دربي أبا خليل

ونبدأ بعون الله ورعايته ... وباسمه نصول ونجول

ودمتم

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

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

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

وشكرا للجميع تقديركم وتشجيعكم لي للمتابعة ....

[أبو آدم]

Capital letters

للكتابة في الحقل باستخدام أحرف كبيرة

Private Sub VinNo_KeyPress(KeyAscii As Integer)

KeyAscii = Asc(UCase(Chr(KeyAscii)))

End Sub

[أبو آدم]

Form Size

لتحديد حجم النموذج ، ارتفاع وعرض

Private Sub Form_Load()

Me.Form.InsideHeight = 6900

Me.Form.InsideWidth = 12700

End Sub

........

[أبو آدم]

Record Source

لتحديد مصدر السجلات للنموذج في أي مرحلة ، عند التحميل ، بعد إنهاء عملية فرز أو بحث أو .....

  Form.RecordSource = "SELECT tbl1ref08.* FROM tbl1ref08;"

أو يكون جملة

	Form.RecordSource = "SELECT tbl1ref08.* FROM tbl1ref08" _

	& " WHERE (((tbl1ref08.[strCenter]) Like '" & MyStr & "' & '*'));"

>>>>>>>>>>>>>

[Bluemind]

فكره ممتازه

بعد اذنك اخوي نارت في المشاركه في هذا الموضوع

[أبو آدم]

أهلا وسهلا

جئت أهلا ووطيئت سهلا

.....

ولكن ....

نراقب بعين الحذر التكرار ، ونتأكد من صحة الأخبار

.....

[أبو آدم]

Doblecated recorde

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

Private Sub OrderID_AfterUpdate()

Dim rst As Recordset

Set rst = Me.RecordsetClone


rst.MoveFirst

Do Until rst.EOF

If rst!strOrder = Me!OrderID And rst!strCenter = Me!Center And rst!strYear = Me!Year Then


MsgBox " Doblecated recorde

", vbExclamation + vbMsgBoxRight + vbMsgBoxRtlReading, " Note;. "


Me.Undo

DoCmd.CancelEvent

Exit Do

End If

rst.MoveNext

Loop

rst.Close


End Sub

[شامل2]

السلام عليكم

فكرة رائعة

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

[أبو آدم]

أخي Bluemind

أنا بالانتظار .....

[أبو آدم]

Conditional Formatting, Alert, Statistics

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

الكود التالي يؤدي الغرض

Private Sub Form_Current()

If Me.strDate < Date Then

Me.ID.BackColor = vbRed

End If

End Sub

وطبعا البساطة والتعقيد تبع للظروف ... والمتطلبات ، ولكن هذه أصل الفكرة

....

القاموس

[أبو آدم]

Date And Time At Forms Caption

لإظهار تاريخ اليوم والوقت بدل اسم النموذج ، الكود التالي يفي بالغرض مع تثبيت الرقم 1000 في Timer Interval

Private Sub Form_Timer()

Me.Caption = "	 Today is " & "Date :" & " " & Format$(Now()), "dd mm yyyy	" & "	Time : " & "h:mm:ss AMPM"

End Sub

>>>>>>>>>>>>

[أبو آدم]

نستخدم في التطبيق بحكم الحاجة الكثير من الرسائل و التنبيهات ، وفي كل مرة نضطر لكتابة الكود وتحديد موصفات وخصائص صندوق الرسائل ، النص و ضبط الازرار و الشكل و العنوان و,,, و,,,

فدعونا ننشيئ وحدة نمطية نستدعيها عند اللزوم

Public Function MsgOK(MsgText As String) As Boolean

Dim LResponse  As Byte

Dim MsgTitle As String

MsgTitle = " تنبيه "

LResponse = MsgBox(MsgText, vbInformation + vbMsgBoxRight, MsgTitle)

If LResponse = vbOK Then

	MsgOK = True

Else

	MsgOK = False

End If

End Function

وحين نحتاجها نستدعيها

Call MsgOK("بسم الله الرحمن الرحيم")

[أبو آدم]

خلال التطبيق تم تفعيل وفتح أكثر من نموذج ، مثل عرض معلومات موظف في نموذج ومن خلاله تم فتح نموذج ثاني لمبيعات هذا الموظف ثم نموذج لطلبيات عميل من عملائه.

في مرحلة معينة اريد اغلاق جميع النماذج مرة واحدة .

دعونا نستخدم الكود التالي :

do while forms.count>0	

	docmd.close acform,forms(0).name  

   loop

,>>>>>>>>>>>>>>>

[أبو آدم]

خطأ # ، Error#

نتيجة مزعجة نحصل عليها في النماذج والتقارير
السبب:
في الحقول التي نقوم بها بأي عملية إحتساب ( sum , count) حين لا يكون هناك سجلات ومعلومات لاحتسابها تظهر هذه النتيجة المزعجة..

الحل في النماذج 2003:
بدلا من استخدام

=Sum([Amount])

نستخدم

=IIf([Form].[Recordset].[RecordCount] > 0, Sum([Amount]), 0)

الحل في التقارير 2007:

=IIf([Report].[HasData], Sum([Amount]), 0))

أما في 2007 فالامر مختلف ، فهو لا يقبل هذا الكود ، ويلزم إنشاء وحدة نمطية ندرج فيها :
 

Public Function FormHasData(frm As Form) As Boolean
    'Purpose:   Return True if the form has any records (other than new one).
    '		   Return False for unbound forms, and forms with no records.
    'Note:	  Avoids the bug in Access 2007 where text boxes cannot use:
    '			   [Forms].[Form1].[Recordset].[RecordCount]
    On Error Resume Next    'To handle unbound forms.
    FormHasData = (frm.Recordset.RecordCount <> 0&)
End Function

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

=IIf(FormHasData([Form]), Sum([Amount]), 0)

وبذلك تنتهي المشكلة ونتخلص من نتائج الخطأ المزعجة ، """ وإذا عرف السبب سهل الحل وبطل العجب """
...........

[أبو آدم]

حذف السجلات Deleting Records

ويروق لي أن اسمي هذا الموضوع بالحذف الحقيقي و الحذف الافتراضي.

في غالب التطبيقات نجد من الضرورة ، أن نضيف في مكان ما من نماذجنا وحسب الحاجة زر أمر نقوم من خلاله بحذف السجلات التي نظن أنها لا تلزمنا أو لسبب ما لا بد من حذفها من قاعدة بياناتنا.

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

وهنا سأورد الرأي بتصرف مضيفا بعضا من خبرتي المتواضعة، فينتهي القول الى:

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

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

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

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

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

ستتعرف لأهمية هذا الروتين البسيط.

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

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

If Msgbox ("You are about to delete data, do you want to continue?", vbYesNo + vbCritical,"Confirm Delete")

= vbYes Then

  CurrentDb.Execute "DELETE MyID FROM MyTable WHERE MyID = " & Me.MyIDControl, dbFailOnError

End If

مع ضرورة التنبيه قبل اجراء عملية الحذف لأنه .... حقيقي....!!!

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

[waloasis]

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

[أبو آدم]

حياك الله

وشكرا على مرورك الطيب

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

[ابو بنسيانا]

بسم الله ماشاء الله

نفعنا بعلمك اخى الكريم

وشكرا على المعلومات القيمة والفكرة الرائعة

[أبو آدم]

اللهم علمنا ما ينفعنا وانفعنا بما علمتنا

شكرا لمرورك الطيب ابو بنسيانا

[youssef103]

ماشاء الله استاذ نارت دائماً متألق

وبرأي يجب جمع جميع الاكواد في هذا الموضوع في ملف WORD أو PDF

بالنسبة لي فقد بدأت الجمع

[أبو آدم]

أخي يوسف

شكرا لثنائك الطيب ، ومرورك أعتز به

جزيت خيرا

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

[أبو آدم]

إسدال مربع التحرير والسرد .... combo box drop down

في النموذج الخاص بادخال البيانات وعند الوصول لمربع التحرير والسرد نحتاج احيانا ان تنسدل محتويات المربع فورا دون الضغط على مؤشر المربع... !!

لمحة جمالية واحترافية وملفتة لنظر المستخدم.

استخدم الكود التالي :

Private Sub cboName_GotFocus()

    Me!cboName.DropDown

End Sub

قضي الأمر .......

...........

[أبو آدم]

تكبير إطار النص .... ZoomBox

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

مهلا ... مهلا

نتحدث هنا عن ZoomBox ، في نموذج إدخال البيانات وخلف مربع النص المعني استخدم الكود:

Private Sub Text2_GotFocus()

DoCmd.RunCommand acCmdZoomBox

End Sub

وفي اي نموذج وعند أي مربع نص وحين تحتاج عرض ZoomBox إضغط Shift+F2 ، وإقرأ البيانات بشكل مريح ، وإضبط خيارات النص بالضغط على Font… في ZoomBox ، وغير نوع الخط و الحجم واللون وشكل الخط مائل ... عريض ... ، وكما تشاء

جرب هذه الفكرة فهي جديرة بتجربتها واستخدامها

[أبو آدم]

وقوف المؤشر عند أول النص في مربع النص .... moves the cursor to the text starting position

عندي في النموذج مجموعة من مربعات النص ، بعضها مضبوط بقناع ادخال سواء للوقت او التاريخ او رقم الهاتف وغيره.

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

جيد ... الامر متاح .... اليك الحل الجذري

أنشيئ وحدة نمطية وأدرج بها الكود التالي:

Function fCursorToStartOnClick()

'* Move cursor to start of text field when clicked

On Error Resume Next

If Len(Screen.ActiveControl.InputMask) > 0 Then

	If IsNull(Screen.ActiveControl) Then

		Screen.ActiveControl.SelStart = 0

	End If

End If

On Error GoTo 0

End Function

ومقابل حدث عند الضغط لمربع النص المعني أدرج الجملة:

=fCursorToStartOnClick()

نفذ التطبيق وحاول - بالضغط داخل الحقل - الوقوف بالمؤشر في اي مكان من المربع (غير بدايته)

وكفى ... قضي الأمر

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

[أبو آدم]

معرفة الطابعة الإفتراضية ....... Default Windows Printer

عبر الشبكة المحلية نستخدم أكثر من طابعة بالاضافة للطابعة الافتراضية PDFCreator ، أثناء استخدام التطبيق العامل في الشركة احتاج قبل الطباعة أن أعرف ما هي الطابعة الإفتراضية الفاعلة .

للوصول لحاجتنا ببساطة ، ننشيئ وحدة نمطية ندرج بها الكود التالي:

Option Compare Database

Option Explicit


Public Declare Function apiGetProfileString 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


Function fDefaultPrinter() As String

	Dim strBuffer As String * 254

	Dim lngReturn As Long

	Dim strDefaultPrinter As String

	lngReturn = apiGetProfileString("WINDOWS", "DEVICE", ",,,", strBuffer, Len(strBuffer))

	fDefaultPrinter = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)

End Function

ثم نقوم باستدعائها من حيث نشاء ، في مصدر الصف في مربع نص :

=fDefaultPrinter()

على شكل رسالة خلف زر أمر باستخدام:

Private Sub DPr_Click()

Dim strDfPr As String

strDfPr = fDefaultPrinter()

MsgBox strDfPr, vbInformation, "Default Prenter"

End Sub

قضي الأمر ...

بسيطة

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