ملفات اساسيه
اسم الجول a
=========
a1 رقم العميل
a2 اسم العميل
a3 تعريف العميل
=========
اسم النوزج
a
=========
كلنا بنعرف كل البرامج
اول شيء بنعمل جدول اسم العميل
كل برنامج
=========
في عامل
في صاحب مصله
في مشتري
في شركه بنشتري منه
في مصاريف
وا الى غير؟؟؟؟؟
========
استلام
مبيعات
مدفوعات
مقبوقات
مصاريف
عمليات ترحيل
عملايات طبع
مزنيه
مقارنه
استعلام ستوك
كله إن شاء الله
بنقدر عليه
Option Compare Database
Option Explicit
Const more_to_left = 10
Dim msg As String
Private Sub cmdSearch_Click()
ss.SetFocus
ss.Dropdown
End Sub
Private Sub oo_Click()
DoCmd.OpenForm ("Po")
End Sub
Private Sub CustomerIDList_Click()
End Sub
Private Sub EX_Click()
DoCmd.Close acForm, "A"
End Sub
Private Sub FLX_Click()
Forms("A").Controls("ftxt1") = FLX.Column(0)
Forms("A").Controls("ftxt2") = FLX.Column(1)
Forms("A").Controls("ftxt3") = FLX.Column(2)
End Sub
Private Sub Form_Open(Cancel As Integer)
DoCmd.MoveSize 567, 0, 10773, 8505
End Sub
Private Sub ftxt1_KeyPress(KeyAscii As Integer)
' ضع هذا الكود في الفورم
If KeyAscii < Asc("0") Or KeyAscii > Asc("9") Then
KeyAscii = 0
End If
End Sub
Private Sub ftxt3_Enter()
ftxt3.Dropdown
End Sub
Sub SetToNull()
ftxt1 = Null
ftxt2 = Null
ftxt3 = Null
End Sub
Private Sub ss_Exit(Cancel As Integer)
ss_AfterUpdate
End Sub
Private Sub ss_AfterUpdate()
If IsNull(ss) Then Exit Sub
Dim db As Database, RS As Recordset
Set db = CurrentDb
Set RS = db.OpenRecordset("A") 'اسم الجدول اساسي اسم العميل
RS.Index = "PrimaryKey"
RS.Seek "=", ss.Column(0)
If RS.NoMatch Then
msg = "لم يعثر على السجل"
ShowMessage msg, 1000
ElseIf Not RS.NoMatch Then
ftxt1 = RS!a1
ftxt2 = RS!A2
ftxt3 = RS!A3
End If
End Sub
Private Sub cmdNew_Click()
On Error GoTo Err_cmdNew_Click
SetToNull
ftxt1 = DMax("A1", "A") + 1 'بزيد رقم من جدول اساسي
ftxt2.SetFocus
Exit_cmdNew_Click:
Exit Sub
Err_cmdNew_Click:
MsgBox Err.Description
Resume Exit_cmdNew_Click
End Sub
Private Sub cmdSave_Click()
On Error GoTo Err_cmdSave_Click
If IsNull(ftxt1) Then
msg = "ادخل رقم العميل"
ShowMessage msg, 1000
ftxt1.SetFocus
Exit Sub
End If
If IsNull(ftxt2) Then
msg = "ادخل اسم العميل"
ShowMessage msg, 1000
ftxt2.SetFocus
Exit Sub
End If
If IsNull(ftxt3) Then
msg = "حدد نوع العميل"
ShowMessage msg, 1000
ftxt3.SetFocus
Exit Sub
End If
'-------------------------------
Dim db As Database, ProductRec As Recordset
Set db = CurrentDb
Set ProductRec = db.OpenRecordset("A")
ProductRec.Index = "PrimaryKey"
ProductRec.Seek "=", ftxt1
With ProductRec
'------------------------------------Existing Item ID.
If Not ProductRec.NoMatch Then
.Edit
!a1 = ftxt1
!A2 = ftxt2
!A3 = ftxt3
.Update
.Close
msg = "تم تعديل السجل رقم: " & ftxt1
ShowMessage msg, 1000
'------------------------------------New Item ID.
ElseIf .NoMatch Then
.AddNew
!a1 = ftxt1
!A2 = ftxt2
!A3 = ftxt3
.Update
.Close
msg = "تم اضافة السجل رقم: " & ftxt1
ShowMessage msg, 1000
End If
DoCmd.Requery "ss"
DoCmd.Requery "FLX"
Exit_cmdSave_Click:
Exit Sub
Err_cmdSave_Click:
MsgBox Err.Description
Resume Exit_cmdSave_Click
End With
End Sub
Private Sub cmdDelete_Click()
If IsNull(ftxt1) Then
msg = "ادخل رقم المادة"
ShowMessage msg, 1000
ss.SetFocus
Exit Sub
End If
'DoCmd.RunMacro "UpdateReleaseReceiveLog"
Dim db As Database, ProductRec As Recordset
Set db = CurrentDb
Set ProductRec = db.OpenRecordset("A")
With ProductRec
.Index = "PrimaryKey"
.Seek "=", ftxt1
If .NoMatch = False Then
If MsgBox("السجل رقم " & ftxt1 & " سيتم مسحه .. هل انت متأكد??", vbYesNo, "مسح") = vbYes Then
.Delete
.Close
SetToNull
msg = "تم مسح السجل.."
ShowMessage msg, 1000
DoCmd.Requery "ss"
DoCmd.Requery "FLX"
Else
Exit Sub
End If
Else
msg = "لم يعثر على السجل رقم . [" & ftxt1 & "] "
ShowMessage msg, 1000
End If
End With
End Sub
Private Sub cmdExit_Click()
DoCmd.Close acDefault
End Sub
'*********************
Sub ShowMessage(strMessage As String, intInterval As Long)
MessageLbl.Top = 851 '1.5cm
MessageLbl.Top = Title.Top
MessageLbl.Left = Title.Left
MessageLbl.Width = Title.Width
MessageLbl.Caption = strMessage
MessageLbl.Visible = True
Me.TimerInterval = intInterval
End Sub
Private Sub Form_Timer()
If MessageLbl.Visible = True Then
MessageLbl.Visible = False
Me.TimerInterval = 0
End If
End Sub
================
نموزج مدفوعات