'****************************
' هذا الروتين سيمكننا من إضافة سجل جديد
'لقاعدة البيانات بعد أن نمرر له إسم القاعده
' ومسارها وإسم الجدول الذى سنضيف السجل إليه
Sub AddNew(DbName As String, strKind As String)
Dim dbs As Database
Dim Rs As Recordset
On Error Resume Next
Select Case strKind
Dim strMsg As String
Dim Count As Byte
Case "Add Saek"
Set dbs = OpenDatabase(DbName)
Set Rs = dbs.OpenRecordset("Saek", dbOpenTable)
With Rs
.AddNew
'لربط أدوات النص بالسجل الجديد
!sname = Trim(TxtInput(0).Text)
!saddress = Trim(TxtInput(1).Text)
!srokhsadegree = Trim(TxtInput(2).Text)
!srokhsano = Trim(TxtInput(3).Text)
!srokhsadate = CDate(TxtInput(4).Text)
!stel = Trim(TxtInput(5).Text)
!smobail = Trim(TxtInput(6).Text)
.Update
'لقد جعلنا الحقل إسم السائق حقل وحيد ولذلك
' عند إضافة حقل جديد قد يخطئ المستخدم ويضع
' إسم موجود مسبقا وعندها سيصدر فيجول بيسك
' رسالة خطأ رقمها 3022
' فى هذه الحاله نخبر المستخدم ان لديه هذا الاسم
' ونغلق الجدول وقاعدة البيانات ونخرج من الروتين
If Err.Number = 3022 Then
MsgBox "يوجد لديك سائق يإسم " & !sname
Rs.Close
dbs.Close
Exit Sub
End If
' نخبر المستخدم انه تم إضافة السجل
' ونخيره إن كان يرغب فى إضافه سجل جديد
' فإن أجاب بنعم نفرغ خانة النص الاولى من محتوايتها
' ونترك له بقيه الخانات كما هى لتوفير الوقت
' فى حالة وجود أكثر من شخص يشترك فى بعض البيانات
' وإن أجاب بلا نلغى تحميل الادوات عن طريق الداله
' UnloadControl
' ونغلق الجدول وقاعدة البيانات
strMsg = MsgBox("تم إضافة السائق " & !sname _
& vbCrLf & "هل ترغب فى إضافة سائق أخر ؟ " _
, vbMsgBoxRight + vbMsgBoxRtlReading _
+ vbQuestion + vbYesNo)
If strMsg = vbNo Then
Rs.Close
dbs.Close
UnLoadControl
Else
TxtInput(0).Text = ""
Rs.Close
dbs.Close
End If
End With
Case "Add Care"
' سنكملها فى الدروس القادمه
Case "Add Amel"
' سنكملها فى الدروس القادمه
Case "Add Tabah"
' سنكملها فى الدروس القادمه
Case "Add Bonat"
' سنكملها فى الدروس القادمه
Case "add Uomeah"
' سنكملها فى الدروس القادمه
Case "Add Masaref Saek"
' سنكملها فى الدروس القادمه
Case "Add Naklah"
' سنكملها فى الدروس القادمه
Case "Add Seuana"
' سنكملها فى الدروس القادمه
End Select
End Subالان سنقوم بإضافة الكود الذى سيمكننا من تحميل الادوات
وقت التنفيذ
'************************************
' هذا الروتين سيمكننا من إضافة الادوات إثناء تنفيذ البرنامج
' وهو يتطلب معرفه إسم الجدول حتى نعرف عدد الادوات
' الواجب إضافتها وعنواينها
'**********************************
Sub LoadControl(MytableName As String)
Dim Count As Byte
If Not TxtInput(0).Visible Then TxtInput(0).Visible _
= True
If Not Slbl(0).Visible Then Slbl(0).Visible = True
Select Case MytableName
Case "Add Saek"
For Count = 1 To 6
'لتحميل الادوات
Load TxtInput(Count)
Load Slbl(Count)
' لتحديد موضع الادوات على النافذه
With TxtInput(Count)
.Left = TxtInput(Count - 1).Left
.Top = TxtInput(Count - 1).Top + TxtInput _
(Count - 1).Height + 50
If Not .Visible Then .Visible = True
End With
With Slbl(Count)
.Left = Slbl(Count - 1).Left
.Top = Slbl(Count - 1).Top + _
Slbl(Count - 1).Height + 50
If Not Slbl(Count).Visible Then _
Slbl(Count).Visible = True
End With
Next Count
' لوضع العناوين
Slbl(0).Caption = "إسم السائق"
Slbl(1).Caption = "العنوان"
Slbl(2).Caption = "درجة الرخصة"
Slbl(3).Caption = "رقمها"
Slbl(4).Caption = "تاريخ الانتهاء"
Slbl(5).Caption = "رقم التليفون"
Slbl(6).Caption = "رقم المحمول"
Case "Care"
Case "View Saek"
Slbl(0).Caption = "أدخل إسم السائق"
If Not TxtInput(0).Visible Then _
TxtInput(0).Visible = True
If Not Slbl(0).Visible Then Slbl(0).Visible _
= True
' بقية الحالات ستم إضافتها فى الدروس القادمه
End Select
If Not CmdOk.Visible Then CmdOk.Visible = True
If Not CmdCancle.Visible Then CmdCancle.Visible = True
End Subوهذ الروتين سقوم بإلغاء تحميل الادوات من على النافذه
'*************************************
' هذا الكود سيقوم بإلغاء تحميل الادوات من على النافذه
' وهو لابطلب أى متغيرات وإنما يقوم بإلغاء تحميل الادوات
' التى تم تحميلها من خلال الكود فقط
Sub UnLoadControl()
Dim Count As Byte
If TxtInput.UBound >= 1 Then
For Count = 1 To TxtInput.UBound
Unload Slbl(Count)
TxtInput(Count).Text = ""
Unload TxtInput(Count)
Next Count
End If
TxtInput(0).Text = ""
If TxtInput(0).Visible = True Then TxtInput(0).Visible _
= False
If Slbl(0).Visible = True Then Slbl(0).Visible = False
If CmdOk.Visible Then CmdOk.Visible = False
If CmdCancle.Visible Then CmdCancle.Visible = False
End Sub
نسيت أقولك فى قسم الاعلانات ضع الاعلان الاتى
Dim Kind_Of_Opration As String
يتبقى روتين أخر وهو الذى يمكننا من مشاهده أى سجل
الموضوع طويل صح ؟؟؟ انا قلتلك فى البدايه طيب
إعملك فنجان قهوه أخر وانا فى إنتظارك
.............
...............
بالهنا والشفا
جاهز الان إذن هيا بنا
' *******************************************
' هذا الروتين يقوم بعرض سجل واحد فقط وهو يتطلب أن
' تدخل له ثلاث متغيرات الاول هو إسم قاعدة البيانات
' الثنى إسم الجدول الذى سنبحث فيه عن السجل
' الثالث هو البيانات التى سنبحث عنها
Sub ViewOne(DbName As String, strTable As String, _
strData As String)
If strData = "" Then Exit Sub
Dim dbs As Database
Dim Rs As Recordset
Dim strFind
On Error Resume Next
Set dbs = OpenDatabase(DbName)
Set Rs = dbs.OpenRecordset(strTable, dbOpenSnapshot)
' ولكن لماذا فتحنا الريكورد سيت كا سناب شوت وليس كاتيبل
' هذه أتركها لذكائك
Dim strMsg As String
Dim Count As Byte
With Rs
.MoveFirst
' ندخل فى تكرار حتى نصل لنهاية الملف
Do While Not Rs.EOF
If Trim(Rs.Fields(0)) = Trim(strData) Then
LoadControl "Add " & strTable
For Count = 0 To TxtInput.UBound
If IsNull(.Fields(Count)) Then
TxtInput(Count).Text = ""
ElseIf IsDate(Rs.Fields(Count)) Then
TxtInput(Count).Text = Format _
(Rs.Fields(Count), "d : m : yyyy")
Else
TxtInput(Count).Text = Rs.Fields _
(Count)
End If
Next Count
Rs.Close
dbs.Close
Exit Sub
End If
.MoveNext
Loop
MsgBox "لايوجد ما تبحث عنه "
End With
End Subخلاص فاضل حاجة صغيره جدا وهى ماذا سيحدث عندما
يضغط المستخدم على أى زر فى PVOutLookBar1
أممممممممممممممم
أليك الكود الخاص بذلك
Private Sub PVOutlookBar1_ItemClick(ByVal Group _
As OUTLOOKBARLibCtl.IPVOutlookGroup, ByVal Item _
As OUTLOOKBARLibCtl.IPVOutlookItem)
Select Case PVOutlookBar1.CurrentGroupIndex
Case 0
Select Case PVOutlookBar1.CurrentGroup _
.CurrentItem.Index
Case 0
UnLoadControl
Kind_Of_Opration = "Add Saek"
LoadControl "Add Saek"
Case 1
UnLoadControl
Kind_Of_Opration = "Add Care"
LoadControl "Add Care"
Case 2
Case 3
Case 4
Case 5
Case 6
Case 7
Case 8
End Select
Case 1
Select Case PVOutlookBar1.CurrentGroup. _
CurrentItem.Index
Case 0
UnLoadControl
Kind_Of_Opration = "View Saek"
LoadControl "View Saek"
Case 1
Case 2
Case 3
Case 4
Case 5
Case 6
Case 7
Case 8
Case 9
End Select
Case 2
Select Case PVOutlookBar1.CurrentGroup. _
CurrentItem.Index
Case 0
frmAbout.Show
Case 1
Case 2
Case 3
Case 4
Set Rs = Nothing
End
End Select
Case 3
Select Case PVOutlookBar1.CurrentGroup. _
CurrentItem.Index
Case 0
Case 1
Case 2
Case 3
Case 4
Case 5
Case 6
Case 7
Case 8
Case 9
End Select
End Select
End Subطبعا معظم الاجراءات لم تكتمل ولكن سنكملها لاحقا
يتبقى نقطه واحده ماذا يحدث عند الضغط على زر موافق
أو زر إلغاء
بسيطه
Private Sub cmdOK_Click()
Select Case Kind_Of_Opration
Case "Add Saek"
AddNew App.Path & "datamydata.mdb", "Add Saek"
Case "View Saek"
ViewOne App.Path & "datamydata.mdb", "Saek", _
Trim(TxtInput(0).Text)
Case "Add Care"
Case "View Care"
' بقية الحالات سنكملها لاحقا
End Select
End SubPrivate Sub CmdCancle_Click()
UnLoadControl
End Subاللهم أغفر لنا ولوالدينا ومعلمينا وأساتذتنا ومشايخنا وكل من له فضل علينا
