بما أني أول مرة أطرح درس في هذا المنتدى أرجو منكم تصحيح الخطاء الذي قد أقع فية بغير قصد أخوكم هشام الحربي
'توضع في الجنرل
Dim db As Database
Dim ws As Workspace 'لحجز مساحة في الذاكرة
Dim rs As Recordset 'كائنن مجموعة سجلات مسئول عن العمليات على السجلات
Dim a
Dim X As String
Private Sub Command1_Click()
Rem لفتح قاعدة بيانات المستأجرين
Set ws = DBEngine.Workspaces(0) 'أما فائدة DBEngine
F = App.Path & "" & "mstager.mdb" 'لإيجاد مسار قاعدة البيانات
Set db = ws.OpenDatabase(F)
Set rs = db.OpenRecordset("mst1", 2)
End Sub
Private Sub Command10_Click()
Rem للبحث عن السجل الاول في قاعدة بيانات المستأجرين
a = rs.Bookmark
X = InputBox("ادخل إسم المستأجر")
rs.FindFirst "mma='" & X & "'"
If rs.NoMatch = True Then
MsgBox ("السجل غير متوفر")
Else
showfield
End If
End Sub
Private Sub Command11_Click()
Rem للبحث في السجل التالي لقاعدة بيانات المستأجرين
a = rs.Bookmark
rs.FindNext "mma='" & X & "'"
If rs.NoMatch = True Then
MsgBox ("السجل غير متوفر")
Else
showfield
End If
End Sub
Private Sub Command12_Click()
Rem للبحث في السجل السابق لقاعدة بيانات المستأجرين
rs.FindPrevious "mma='" & X & "'"
If rs.NoMatch = True Then
MsgBox ("السجل غير متوفر")
Else
showfield
End If
End Sub
Private Sub Command13_Click()
Rem للبحث في السجل الأخير لقاعدة بيانات المستأجرين
X = InputBox("ادخل إسم المستأجر")
rs.FindLast "mma='" & X & "'"
If rs.NoMatch = True Then
MsgBox ("السجل غير متوفر")
Else
showfield
End If
End Sub
Private Sub Command14_Click()
Rem للعودة لسجل السابق في قاعدة البيانات
rs.Bookmark = a
showfield
End Sub
Private Sub Command15_Click()
Rem لمسح محتويات صناديق لإدخال
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
End Sub
Private Sub Command17_Click()
'لطباعة البيانات ولكن بة مشكلة أنة يطبع البيانات وكنة يضعها في الركن العلوي لصفحة
Printer.CurrentX = 7000
Printer.CurrentY = 2000
Printer.FontSize = 20
Printer.FontBold = True
Printer.Print Text1.Text, Label1
Printer.Print Text2.Text, Label2
Printer.Print Text3.Text, Label3
Printer.Print Text4.Text, label4
Printer.Print Text5.Text, Label5
Printer.Print Text6.Text, Label6
Printer.Print Text7.Text, Label7
Printer.Print Text8.Text, Label8
Printer.Print Text9.Text, Label9
Printer.Print Text10.Text, Label10
Printer.Print Text11.Text, Label11
Printer.Print Text12.Text, Label12
Printer.EndDoc
End Sub
Private Sub Command2_Click()
Rem لإظافة بيانات مستأجر جديد إلى قاعدة البيانات
rs.AddNew
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
End Sub
Private Sub Command3_Click()
Rem لحفظ بيانات المستأجر المدخلة في قاعدة البيانات
rs("mma") = Val(Text1.Text) 'إذا كان رقم
rs("mmb") = Text2.Text 'إذا كان نص
rs("mmd") = Text3.Text
rs("mmc") = Text4.Text
rs("mme") = Text5.Text
rs("mmm") = Text6.Text
rs("mmh") = Val(Text7.Text)
rs("mml") = Text8.Text
rs("mmz") = Text9.Text
rs("mmf") = Text10.Text
rs("mmk") = Text11.Text
rs("mmq") = Text12.Text
rs.Update 'حفظ السجل
End Sub
Private Sub Command4_Click()
Rem لإظافة تعديل في أحد بيانات المستأجرين الموجودة
rs.Edit
End Sub
Private Sub Command5_Click()
Rem لحذف أحد السجلات الغير مرغوب فيها في قاعدة البيانات
rs.Delete
rs.MoveNext
showfield
End Sub
Private Sub Command6_Click()
Rem لعرض السجل الأول في قاعدة البيانات للمستأجرين
rs.MoveFirst
showfield
End Sub
Private Sub Command7_Click()
Rem لعرض السجل التالي في قاعدة بيانات المستأجرين
rs.MoveNext
If rs.EOF Then rs.MoveLast
showfield
End Sub
Private Sub Command8_Click()
Rem لعرض السجل السابق في قاعدة بيانات المستأجرين
rs.MovePrevious
If rs.BOF Then rs.MoveFirst
showfield
End Sub
Private Sub Command9_Click()
Rem لعرض السجل الأخير الموجود في قاعدة بيانات المستأجرين
rs.MoveLast
showfield
End Sub
Private Sub خروج_Click()
Rem الخروج من البرنامج
msg$ = " هل ترغب حقاً في إنهاء البرنامج "
Title = "الخروج من البرنامج"
response = MsgBox(msg, 36, Title)
If response = 6 Then End
End Sub
Private Sub showfield()
'طريقة عرض سجلات من الجدول إلى النموذج
Text1.Text = rs("mma")
Text2.Text = rs("mmb")
Text3.Text = rs("mmd")
Text4.Text = rs("mmc")
Text5.Text = rs("mme")
Text6.Text = rs("mmm")
Text7.Text = rs("mmh")
Text8.Text = rs("mml")
Text9.Text = rs("mmz")
Text10.Text = rs("mmf")
Text11.Text = rs("mmk")
Text12.Text = rs("mmq")
End Sub
'وتذكر أن تضيف الأداة
'Microsoft DAO 3.6 object library
'project وتضيفة بنقر على
'References ثم النقر على على
'الأداة المذكورة
'وتذكر أن تدعو لي ولاتدعو علي
'وإذا كنت أخطاءة فأرجو المعذرة وإن كنت أصبت فهذا فضل من الله
'ولا نستغني عن أرائكم وملاحضاتكم الهادفة أخوكم هشام الحربي
'وشكراً لمنتدى الفريق العربي للبرمجة
'توضع في الجنرل
Dim db As Database
Dim ws As Workspace 'لحجز مساحة في الذاكرة
Dim rs As Recordset 'كائنن مجموعة سجلات مسئول عن العمليات على السجلات
Dim a
Dim X As String
Private Sub Command1_Click()
Rem لفتح قاعدة بيانات المستأجرين
Set ws = DBEngine.Workspaces(0) 'أما فائدة DBEngine
F = App.Path & "" & "mstager.mdb" 'لإيجاد مسار قاعدة البيانات
Set db = ws.OpenDatabase(F)
Set rs = db.OpenRecordset("mst1", 2)
End Sub
Private Sub Command10_Click()
Rem للبحث عن السجل الاول في قاعدة بيانات المستأجرين
a = rs.Bookmark
X = InputBox("ادخل إسم المستأجر")
rs.FindFirst "mma='" & X & "'"
If rs.NoMatch = True Then
MsgBox ("السجل غير متوفر")
Else
showfield
End If
End Sub
Private Sub Command11_Click()
Rem للبحث في السجل التالي لقاعدة بيانات المستأجرين
a = rs.Bookmark
rs.FindNext "mma='" & X & "'"
If rs.NoMatch = True Then
MsgBox ("السجل غير متوفر")
Else
showfield
End If
End Sub
Private Sub Command12_Click()
Rem للبحث في السجل السابق لقاعدة بيانات المستأجرين
rs.FindPrevious "mma='" & X & "'"
If rs.NoMatch = True Then
MsgBox ("السجل غير متوفر")
Else
showfield
End If
End Sub
Private Sub Command13_Click()
Rem للبحث في السجل الأخير لقاعدة بيانات المستأجرين
X = InputBox("ادخل إسم المستأجر")
rs.FindLast "mma='" & X & "'"
If rs.NoMatch = True Then
MsgBox ("السجل غير متوفر")
Else
showfield
End If
End Sub
Private Sub Command14_Click()
Rem للعودة لسجل السابق في قاعدة البيانات
rs.Bookmark = a
showfield
End Sub
Private Sub Command15_Click()
Rem لمسح محتويات صناديق لإدخال
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
End Sub
Private Sub Command17_Click()
'لطباعة البيانات ولكن بة مشكلة أنة يطبع البيانات وكنة يضعها في الركن العلوي لصفحة
Printer.CurrentX = 7000
Printer.CurrentY = 2000
Printer.FontSize = 20
Printer.FontBold = True
Printer.Print Text1.Text, Label1
Printer.Print Text2.Text, Label2
Printer.Print Text3.Text, Label3
Printer.Print Text4.Text, label4
Printer.Print Text5.Text, Label5
Printer.Print Text6.Text, Label6
Printer.Print Text7.Text, Label7
Printer.Print Text8.Text, Label8
Printer.Print Text9.Text, Label9
Printer.Print Text10.Text, Label10
Printer.Print Text11.Text, Label11
Printer.Print Text12.Text, Label12
Printer.EndDoc
End Sub
Private Sub Command2_Click()
Rem لإظافة بيانات مستأجر جديد إلى قاعدة البيانات
rs.AddNew
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""
Text11.Text = ""
Text12.Text = ""
End Sub
Private Sub Command3_Click()
Rem لحفظ بيانات المستأجر المدخلة في قاعدة البيانات
rs("mma") = Val(Text1.Text) 'إذا كان رقم
rs("mmb") = Text2.Text 'إذا كان نص
rs("mmd") = Text3.Text
rs("mmc") = Text4.Text
rs("mme") = Text5.Text
rs("mmm") = Text6.Text
rs("mmh") = Val(Text7.Text)
rs("mml") = Text8.Text
rs("mmz") = Text9.Text
rs("mmf") = Text10.Text
rs("mmk") = Text11.Text
rs("mmq") = Text12.Text
rs.Update 'حفظ السجل
End Sub
Private Sub Command4_Click()
Rem لإظافة تعديل في أحد بيانات المستأجرين الموجودة
rs.Edit
End Sub
Private Sub Command5_Click()
Rem لحذف أحد السجلات الغير مرغوب فيها في قاعدة البيانات
rs.Delete
rs.MoveNext
showfield
End Sub
Private Sub Command6_Click()
Rem لعرض السجل الأول في قاعدة البيانات للمستأجرين
rs.MoveFirst
showfield
End Sub
Private Sub Command7_Click()
Rem لعرض السجل التالي في قاعدة بيانات المستأجرين
rs.MoveNext
If rs.EOF Then rs.MoveLast
showfield
End Sub
Private Sub Command8_Click()
Rem لعرض السجل السابق في قاعدة بيانات المستأجرين
rs.MovePrevious
If rs.BOF Then rs.MoveFirst
showfield
End Sub
Private Sub Command9_Click()
Rem لعرض السجل الأخير الموجود في قاعدة بيانات المستأجرين
rs.MoveLast
showfield
End Sub
Private Sub خروج_Click()
Rem الخروج من البرنامج
msg$ = " هل ترغب حقاً في إنهاء البرنامج "
Title = "الخروج من البرنامج"
response = MsgBox(msg, 36, Title)
If response = 6 Then End
End Sub
Private Sub showfield()
'طريقة عرض سجلات من الجدول إلى النموذج
Text1.Text = rs("mma")
Text2.Text = rs("mmb")
Text3.Text = rs("mmd")
Text4.Text = rs("mmc")
Text5.Text = rs("mme")
Text6.Text = rs("mmm")
Text7.Text = rs("mmh")
Text8.Text = rs("mml")
Text9.Text = rs("mmz")
Text10.Text = rs("mmf")
Text11.Text = rs("mmk")
Text12.Text = rs("mmq")
End Sub
'وتذكر أن تضيف الأداة
'Microsoft DAO 3.6 object library
'project وتضيفة بنقر على
'References ثم النقر على على
'الأداة المذكورة
'وتذكر أن تدعو لي ولاتدعو علي
'وإذا كنت أخطاءة فأرجو المعذرة وإن كنت أصبت فهذا فضل من الله
'ولا نستغني عن أرائكم وملاحضاتكم الهادفة أخوكم هشام الحربي
'وشكراً لمنتدى الفريق العربي للبرمجة
يجب عليك انشاء قاعدة بيانات وتحدد عدد التكستات التي تريد وهكذا
وإذا كان هناك خطاء فأعينوني على تصحيحة