اريد حل لهذه الرسالة المزعجة

اخي الفاضل

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

If Not rs.EOF Then

بالتوفيق

اشكرك جدا على هذه الاجابة بس لتكونى مفهومة ليا اكثر هل من الممكن اعطائى اجابة اين اكتب هذا الكوذ فى اى حدث ولو افضل مثال من عندك للتوضيح اكثر

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

وهذه هى اكواد نموذج المشتريات

Option Compare Database

Option Explicit

Dim mFormHeight

Dim mFormWidth

Dim mFormTop

Dim mFormLeft

Dim Msg, Style, Title, Help, Ctxt, Response, MyString, mResult

Dim Anim As clsFormAnimate

Dim lst As Access.ListBox

Dim txt As Access.TextBox

Dim strSQL As String

Dim varSelectedItem As Variant

Private mc As clsMonthCal

Private Sub Cash_Exit(Cancel As Integer)

On Error GoTo xx

Me.cmdsaverec.SetFocus

xx:

End Sub

Private Sub cmd_undo1_Click()

On Error GoTo Err_cmd_undo_Click

DoCmd.SetWarnings False

With Me

.AllowAdditions = False

.AllowEdits = True

.AllowDeletions = True

End With

DoCmd.DoMenuItem acFormBar, acEditMenu, acUndo, , acMenuVer70

Exit_cmd_undo_Click:

DoCmd.SetWarnings True

user_licence

no_add_mod_del

Exit Sub

Err_cmd_undo_Click:

If Err.Number = 2046 Or Err.Number = 3201 Or Err.Number = 3314 Then

Resume Exit_cmd_undo_Click

End If

Handle_Errors_ADO "", Err.Number, Err.Description

Resume Exit_cmd_undo_Click

End Sub

Private Sub Command116_Click()

On Error GoTo xx

Dim blRet As Boolean

Dim dtStart As Date, dtEnd As Date

If Me.cmd_add.Enabled = False Or Me.cmd_mod.Enabled = False Then

dtStart = date

dtEnd = 0

blRet = ShowMonthCalendar(mc, dtStart, dtEnd)

If blRet = True Then

Me.TranDate = dtStart

Else

MsgBox "åá äÓíÊ ÇÏÎÇá ÇáÊÇÑíÎ", vbOKOnly, " ÇáÊÇÑíÎ"

End If

Me.STK_SER.SetFocus

End If

xx:

' Handle_Errors_ADO "", Err.Number, Err.Description

End Sub

Private Sub Command115_Click()

On Error GoTo Err_Command115_Click

Me.STK_SER.SetFocus

Dim stDocName As String

Dim stLinkCriteria As String

stDocName = "vendors"

DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Command115_Click:

Exit Sub

Err_Command115_Click:

MsgBox Err.Description

Resume Exit_Command115_Click

End Sub

Private Sub Command118_Click()

On Error GoTo Err_Command118_Click

Me.TranDate.SetFocus

Dim stDocName As String

Dim stLinkCriteria As String

stDocName = "stock"

DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_Command118_Click:

Exit Sub

Err_Command118_Click:

MsgBox Err.Description

Resume Exit_Command118_Click

End Sub

Sub nosub()

On Error GoTo xx

If Me!Posted Then

With Me

.PurInvDt.Enabled = False

End With

Else

With Me

.PurInvDt.Enabled = True

End With

End If

xx:

End Sub

Private Sub Form_Current()

nosub

End Sub

Private Sub Form_Unload(Cancel As Integer)

On Error GoTo xx

' This is required in case user Closes Form with the

' Calendar still open. It also handles when the

' user closes the application with the Calendar

' still open.

If Not mc Is Nothing Then

If mc.IsCalendar Then

Cancel = 1

Exit Sub

End If

Set mc = Nothing

End If

xx:

' Handle_Errors_ADO "", Err.Number, Err.Description

End Sub

Private Sub Form_Load()

On Error GoTo xx

Dim a As Integer

' This must appear here!

' Create an instance of our Class

Set mc = New clsMonthCal

' You MUST SET the class hWndForm prop!!!

mc.hWndForm = Me.hwnd

a = Int((28 * Rnd) + 1)

Select Case a

Case 1

Me.FormFooter.BackColor = 14403521

Me.FormHeader.BackColor = 14403521

Me.Detail.BackColor = 14403521

Case 2

Me.FormFooter.BackColor = 16421253

Me.FormHeader.BackColor = 16421253

Me.Detail.BackColor = 16421253

Case 3

Me.FormFooter.BackColor = 16492959

Me.FormHeader.BackColor = 16492959

Me.Detail.BackColor = 16492959

Case 4

Me.FormFooter.BackColor = 16561323

Me.FormHeader.BackColor = 16561323

Me.Detail.BackColor = 16561323

Case 5

Me.FormFooter.BackColor = 16630973

Me.FormHeader.BackColor = 16630973

Me.Detail.BackColor = 16630973

Case 6

Me.FormFooter.BackColor = 16700367

Me.FormHeader.BackColor = 16700367

Me.Detail.BackColor = 16700367

Case 7

Me.FormFooter.BackColor = 16704224

Me.FormHeader.BackColor = 16704224

Me.Detail.BackColor = 16704224

Case 8

Me.FormFooter.BackColor = 16774130

Me.FormHeader.BackColor = 16774130

Me.Detail.BackColor = 16774130

Case 9

Me.FormFooter.BackColor = 10681796

Me.FormHeader.BackColor = 10681796

Me.Detail.BackColor = 10681796

Case 10

Me.FormFooter.BackColor = 15728569

Me.FormHeader.BackColor = 15728569

Me.Detail.BackColor = 15728569

Case 11

Me.FormFooter.BackColor = 15597488

Me.FormHeader.BackColor = 15597488

Me.Detail.BackColor = 15597488

Case 12

Me.FormFooter.BackColor = 14745463

Me.FormHeader.BackColor = 14745463

Me.Detail.BackColor = 14745463

Case 13

Me.FormFooter.BackColor = 12451474

Me.FormHeader.BackColor = 12451474

Me.Detail.BackColor = 12451474

Case 14

Me.FormFooter.BackColor = 10223575

Me.FormHeader.BackColor = 10223575

Me.Detail.BackColor = 10223575

Case 15

Me.FormFooter.BackColor = 16772014

Me.FormHeader.BackColor = 16772014

Me.Detail.BackColor = 16772014

Case 16

Me.FormFooter.BackColor = 16699135

Me.FormHeader.BackColor = 16699135

Me.Detail.BackColor = 16699135

Case 17

Me.FormFooter.BackColor = 9105153

Me.FormHeader.BackColor = 9105153

Me.Detail.BackColor = 9105153

Case 18

Me.FormFooter.BackColor = 14672127

Me.FormHeader.BackColor = 14672127

Me.Detail.BackColor = 14672127

Case 19

Me.FormFooter.BackColor = 11061759

Me.FormHeader.BackColor = 11061759

Me.Detail.BackColor = 11061759

Case 20

Me.FormFooter.BackColor = 10414590

Me.FormHeader.BackColor = 10414590

Me.Detail.BackColor = 10414590

Case 21

Me.FormFooter.BackColor = 7994838

Me.FormHeader.BackColor = 7994838

Me.Detail.BackColor = 7994838

Case 22

Me.FormFooter.BackColor = 8781491

Me.FormHeader.BackColor = 8781491

Me.Detail.BackColor = 8781491

Case 23

Me.FormFooter.BackColor = 14089782

Me.FormHeader.BackColor = 14089782

Me.Detail.BackColor = 14089782

Case 24

Me.FormFooter.BackColor = 16705136

Me.FormHeader.BackColor = 16705136

Me.Detail.BackColor = 16705136

Case 25

Me.FormFooter.BackColor = 16500091

Me.FormHeader.BackColor = 16500091

Me.Detail.BackColor = 16500091

Case 26

Me.FormFooter.BackColor = 16686226

Me.FormHeader.BackColor = 16686226

Me.Detail.BackColor = 16686226

Case 27

Me.FormFooter.BackColor = 14655727

Me.FormHeader.BackColor = 14655727

Me.Detail.BackColor = 14655727

Case 28

Me.FormFooter.BackColor = 10390517

Me.FormHeader.BackColor = 10390517

Me.Detail.BackColor = 10390517

End Select

Set GENERAL.GLFRM = Me

' delete filter

GLFRM.Filter = ""

GLFRM.FilterOn = False

DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70

' read user licence

user_licence

' when open form no add - no modify - no delete

no_add_mod_del

Me.cmdsaverec.Enabled = False

Me.cmd_undo.Enabled = False

Me.cmd_Undo_sub.Enabled = False

Me.CmdPost.Enabled = True

Me.CmdUnPost.Enabled = True

Me.cmdprv.Enabled = True

xx:

' Handle_Errors_ADO "", Err.Number, Err.Description

End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)

Dim lerr As Long

lerr = DataErr

Handle_Errors_ADO "", lerr, Err.Description

Response = False

End Sub

Sub CALC_INV_TOT()

On Error GoTo xx

Dim TOT As Double

Dim strSQL As String

strSQL = "SELECT sum(TransDt.Qty*TransDt.PRICE) " & _

" FROM Trans INNER JOIN TransDt ON Trans.Ser = TransDt.Tran_Ser WHERE Trans.Ser=" & Me!SER

Dim rst As New ADODB.Recordset

rst.Open strSQL, CurrentProject.Connection, _

adOpenKeyset, adLockOptimistic

rst.MoveFirst

TOT = rst.Fields(0)

Me!Total = TOT

rst.Close

Exit Sub

xx:

' Handle_Errors_ADO "", Err.Number, Err.Description

If Err.Number = 2448 Then

Exit Sub

Else

Me!Total = 0

End If

End Sub

Public Sub update_stock(Typ As Integer)

On Error GoTo Err_Error_BT_Click

Dim ritm As New ADODB.Recordset

Dim rst As New ADODB.Recordset

Dim rstdt As New ADODB.Recordset

Dim sqlstr As String

Dim SQLstr2 As String

Dim sqlstr3 As String

Dim rstdt3 As New ADODB.Recordset

sqlstr = "select Itm_Ser,Unt_Ser,Qty from TransDt where Tran_Ser = " & CStr(Me!SER)

ritm.Open sqlstr, CurrentProject.Connection, _

adOpenKeyset, adLockOptimistic

If Not ritm.BOF And Not ritm.EOF Then

ritm.MoveFirst

While Not ritm.EOF

SQLstr2 = "select * from Stk_StockItem where stk_ser = " & CStr(Me!STK_SER)

SQLstr2 = SQLstr2 & " and ITM_SER=" & CStr(ritm!Itm_Ser)

SQLstr2 = SQLstr2 & " and UNT_SER=" & CStr(ritm!Unt_Ser)

rstdt.Open SQLstr2, CurrentProject.Connection, _

adOpenKeyset, adLockOptimistic

'***************************************************************

sqlstr3 = "select CTG_SER from Stk_Item where ser = " & CStr(ritm!Itm_Ser)

rstdt3.Open sqlstr3, CurrentProject.Connection, _

adOpenKeyset, adLockOptimistic

'***************************************************************

If rstdt.RecordCount = 0 Then

rstdt.AddNew

rstdt!STK_SER = Me!STK_SER

rstdt!Itm_Ser = ritm!Itm_Ser

rstdt!Unt_Ser = ritm!Unt_Ser

rstdt!CTG_SER = rstdt3!CTG_SER

rstdt!ADDBAL = ritm!Qty * Typ

rstdt.Update

Else

rstdt.MoveFirst

rstdt!ADDBAL = rstdt!ADDBAL + ritm!Qty * Typ

rstdt.Update

End If

rstdt.Close

rstdt3.Close

ritm.MoveNext

Wend

Else

ritm.Close

End If

Exit_Error_BT_Click:

Exit Sub

Err_Error_BT_Click:

Handle_Errors_ADO "", Err.Number, Err.Description

rstdt.Close

rstdt3.Close

Resume Exit_Error_BT_Click

End Sub

Public Sub Update_ItmUntPrices(Typ As Integer)

On Error GoTo xx

Dim itm_Discount As Double

Dim itm_nakl_cost As Double

Dim errLoop As ADODB.Error

Dim rstdt As New ADODB.Recordset

Dim sqlstr As String

Dim SqlItm As String

Dim RsItm As New ADODB.Recordset

Dim item_price As Double

Dim TOT_INV As Double

' ÍÕÑ ÊÝÇÕíá ÇáÝÇÊæÑÉ

sqlstr = "select * from TransDt where Tran_ser = " & CStr(Me!SER)

rstdt.Open sqlstr, CurrentProject.Connection, _

adOpenKeyset, adLockOptimistic

If Not rstdt.BOF And Not rstdt.EOF Then

rstdt.MoveFirst

' ÇáãÑæÑ Úáì ÊÝÇÕíá ÇáÝÇÊæÑÉ

While Not rstdt.EOF

'ÊÍÏíÏ ÇáÕäÝ æÇáæÍÏÉ ãÊä ÌÏæá æÍÏÇÊ ÇáÃÕäÇÝ

SqlItm = "select * from Stk_ItemUnit where Itm_ser = " & CStr(rstdt!Itm_Ser)

SqlItm = SqlItm & " and unt_ser = " & CStr(rstdt!Unt_Ser)

'RsItm.Close

RsItm.Open SqlItm, CurrentProject.Connection, _

adOpenKeyset, adLockOptimistic

If Not RsItm.BOF And Not RsItm.EOF Then

RsItm.MoveFirst

item_price = 0

If (Me!Total) = 0 Then

TOT_INV = 1

Else

TOT_INV = (Me!Total)

End If

'ÊæÒíÚ ÇáÎÕã Úáì ßá ÇáÇÕäÇÝ Úáì ÍÓÈ ÇáÞíãÉ

itm_Discount = ((((rstdt!Qty * rstdt!PRICE) / IIf((Me!Total) = 0, 1, (Me!Total))) * (Me!Discount))) / (rstdt!Qty)

'ÊæÒíÚ ãÕÇÑíÝ ÇáäÞá Úáì ßá ÇáÇÕäÇÝ Úáì ÍÓÈ ÇáÞíãÉ

itm_nakl_cost = Format((((((rstdt!Qty * rstdt!PRICE) / IIf((Me!Total) = 0, 1, (Me!Total))) * (Me!nakl_cost))) / (rstdt!Qty)), "#######0.00000")

'ÇáÓÚÑ ÇáÝÚáì áÊßáÝÉ ÇáÔÑÇÁ(ÓÚÑ ÇáÔÑÇÁ + ãÕÇÑíÝ ÇáäÞá - ÇáÎÕã ÇáãßÊÓÈ

item_price = ((rstdt!PRICE) + (itm_nakl_cost) - (itm_Discount))

With RsItm

' 'ÇáÓÚÑ ÇáÃÚáì

If !MAX_PRC_SAL < rstdt!PRICE Then

!MAX_PRC_SAL = rstdt!PRICE

End If

' 'ÇáÓÚÑ ÇáÃÞá

If !MIN_PRC_SAL = 0 Or !MIN_PRC_SAL > rstdt!PRICE Then

!MIN_PRC_SAL = rstdt!PRICE

End If

' 'ÇáÓÚÑ ÇáãÊæÓØ

If (!CurQtySal + rstdt!Qty * Typ) <> 0 Then

' !AVG_PRC_SAL = ((!AVG_PRC_SAL * !CurQtySal) + (rstdt!PRICE * rstdt!Qty * Typ)) / (!CurQtySal + rstdt!Qty * Typ)

' !AVG_PRC_SAL = Round((((!AVG_PRC_SAL * !CurQtySal) + (item_price * rstdt!Qty * Typ)) / (!CurQtySal + rstdt!Qty * Typ)), 3)

!AVG_PRC_SAL = (((!AVG_PRC_SAL * !CurQtySal) + (item_price * rstdt!Qty * Typ)) / (!CurQtySal + rstdt!Qty * Typ))

End If

' 'ÂÎÑ ÓÚÑ ÔÑÇÁ

!LST_PRC_SAL = rstdt!PRICE

' 'ÇáßãíÉ ÇáãÔÊÑÇå

!CurQtySal = !CurQtySal + (rstdt!Qty * Typ)

.Update

.Close

End With

Else

RsItm.Close

End If

rstdt.MoveNext

Wend

End If

'ÚáÇÁ

rstdt.Close

xx:

' Handle_Errors_ADO "", Err.Number, Err.Description

End Sub

Public Sub update_vendCust(Typ As Integer)

On Error GoTo xx

Dim strSQLChange As String

Dim strCnn As String

Dim cnn1 As ADODB.Connection

Dim cmdChange As ADODB.Command

Dim errLoop As ADODB.Error

' ÊÚÏíá ÑÕíÏ ÇáãæÑÏ

strSQLChange = "UPDATE VendCust SET CURBALCr = CURBALCr+" & _

(Me!Total - Me!Discount) * Typ & " where ser =" & Me!Vnd_Cust

' Open connection.

Set cmdChange = New ADODB.Command

Set cmdChange.ActiveConnection = CurrentProject.Connection

cmdChange.CommandText = strSQLChange

cmdChange.Execute

Exit Sub

xx:

' Notify user of any errors that result from

' executing the query.

Handle_Errors_ADO "", Err.Number, Err.Description

End Sub

Private Sub CmdPost_Click()

On Error GoTo xx

If Not Me!Posted Then

Me!Posted = True

Me.cmdsaverec.Enabled = True

Me.cmd_mod.Enabled = False

Me.cmd_add.Enabled = False

Me.cmdfindrec.Enabled = False

Me.cmd_fresh.Enabled = False

Me.cmddelrec.Enabled = False

Me.cmdexitrec.Enabled = False

Me.cmdfirstrec.Enabled = False

Me.cmdlastrec.Enabled = False

Me.cmdnextrec.Enabled = False

Me.cmdprevrec.Enabled = False

Me.cmd_add_sub_tr_no.Enabled = False

Me.cmd_delsubrec.Enabled = False

' ãÎÒæä ÓáÚì Çæá ÇáãÏÉ ÇáãæÑÏ = 0

If Me!Vnd_Cust = 0 Then

update_2201yawmeya 1

Else

' ããÔÊÑíÇÊ ÇÌáÉ

If Not Me!Cash Then

update_vendCust 1

update_yawmeya_notcash 1

Else

' ããÔÊÑíÇÊ äÞÏíÉ

update_yawmeya_cash 1

End If

End If

'ÊÍÏíË ÇáãÎÒä æ ÇáãÊæÓØ ÇáãÑÌÍ

update_stock 1

Update_ItmUntPrices 1

Else

Style = vbOKOnly

Title = " ãßÊÈ ÇáÊæÍíÏ"

If MsgBox(" ÛíÑ ãÓãæÍ ÈÇáÊÚÏíá áÇä ÇáÝÇÊæÑÉ ãÑÍáÉ ", Style, Title) = vbOK Then

End If

End If

no_add_mod_del

' Me.PurInvDt.SetFocus

nosub

Me.cmdsaverec.SetFocus

xx:

' Handle_Errors_ADO "", Err.Number, Err.Description

End Sub

Private Sub CmdUnPost_Click()

On Error GoTo xx

If Me!Posted Then

Me!Posted = False

Me.cmdsaverec.Enabled = True

Me.cmd_mod.Enabled = False

Me.cmd_add.Enabled = False

Me.cmdfindrec.Enabled = False

Me.cmd_fresh.Enabled = False

Me.cmddelrec.Enabled = False

Me.cmdexitrec.Enabled = False

Me.cmdfirstrec.Enabled = False

Me.cmdlastrec.Enabled = False

Me.cmdnextrec.Enabled = False

Me.cmdprevrec.Enabled = False

Me.cmd_add_sub_tr_no.Enabled = False

Me.cmd_delsubrec.Enabled = False

' ãÎÒæä ÓáÚì Çæá ÇáãÏÉ ÇáãæÑÏ = 0

If Me!Vnd_Cust = 0 Then

update_2201yawmeya -1

Else

' ããÔÊÑíÇÊ ÇÌáÉ

If Not Me!Cash Then

update_vendCust -1

update_yawmeya_notcash -1

Else

' ããÔÊÑíÇÊ äÞÏíÉ

update_yawmeya_cash -1

End If

End If

'ÊÍÏíË ÇáãÎÒä æ ÇáãÊæÓØ ÇáãÑÌÍ

update_stock -1

Update_ItmUntPrices -1

Else

Style = vbOKOnly

Title = " ãßÊÈ ÇáÊæÍíÏ"

If MsgBox(" ÛíÑ ãÓãæÍ ÈÇáÊÚÏíá áÇä ÇáÝÇÊæÑÉ ÛíÑ ãÑÍáÉ ", Style, Title) = vbOK Then

End If

End If

no_add_mod_del

' Me.PurInvDt.SetFocus

nosub

Me.cmdsaverec.SetFocus

xx:

' Handle_Errors_ADO "", Err.Number, Err.Description

End Sub

Public Sub update_yawmeya_notcash(Typ As Integer)

Dim strSQLChange As String

Dim cmdChange As ADODB.Command

Dim strSQLChange1 As String

Dim cmdChange1 As ADODB.Command

Dim strSQLChange2 As String

Dim cmdChange2 As ADODB.Command

Dim strSQLChange3 As String

Dim cmdChange3 As ADODB.Command

Dim strSQLChange4 As String

Dim cmdChange4 As ADODB.Command

Dim errLoop As ADODB.Error

'ãä ÍÓÇÈ ãÐßæÑíä

'----------------

' ãä / ÍÓÇÈ ãÔÊÑíÇÊ

strSQLChange = "UPDATE accounts SET curbal_dr = curbal_dr + " & _

(Me!Total) * Typ & " where acc_code = 3104"

' ãä / ÍÓÇÈ ãÕÑæÝÇÊ ãÔÊÑíÇÊ äÞÏíÉ

strSQLChange3 = "UPDATE accounts SET curbal_dr = curbal_dr + " & _

(Me.nakl_cost) * Typ & " where acc_code = 3105"

'Çáì ÍÓÇÈ ãÐßæÑíä

'----------------

' Çáì / ÍÓÇÈ ãæÑÏíä

strSQLChange1 = "UPDATE accounts SET curbal_cr = curbal_cr + " & _

(Me!Total - Me!Discount) * Typ & " where acc_code = 2101"

' Çáì / ÍÓÇÈ ÎÕã ãßÊÓÈ

strSQLChange2 = "UPDATE accounts SET curbal_cr = curbal_cr + " & _

(Me!Discount) * Typ & " where acc_code = 4105"

' Çáì / äÞÏíÉ

strSQLChange4 = "UPDATE accounts SET curbal_cr = curbal_cr + " & _

(Me.nakl_cost) * Typ & " where acc_code = 1101"

' Open connection.

Set cmdChange = New ADODB.Command

Set cmdChange.ActiveConnection = CurrentProject.Connection

cmdChange.CommandText = strSQLChange

cmdChange.Execute

' Open connection.

Set cmdChange1 = New ADODB.Command

Set cmdChange1.ActiveConnection = CurrentProject.Connection

cmdChange1.CommandText = strSQLChange1

cmdChange1.Execute

' Open connection.

Set cmdChange2 = New ADODB.Command

Set cmdChange2.ActiveConnection = CurrentProject.Connection

cmdChange2.CommandText = strSQLChange2

cmdChange2.Execute

' Open connection.

Set cmdChange3 = New ADODB.Command

Set cmdChange3.ActiveConnection = CurrentProject.Connection

cmdChange3.CommandText = strSQLChange3

cmdChange3.Execute

' Open connection.

Set cmdChange4 = New ADODB.Command

Set cmdChange4.ActiveConnection = CurrentProject.Connection

cmdChange4.CommandText = strSQLChange4

cmdChange4.Execute

Exit Sub

Err_Execute:

' Notify user of any errors that result from

' executing the query.

Handle_Errors_ADO "", Err.Number, Err.Description

' Resume Next

End Sub

Public Sub update_yawmeya_cash(Typ As Integer)

Dim strSQLChange As String

Dim cmdChange As ADODB.Command

Dim strSQLChange1 As String

Dim cmdChange1 As ADODB.Command

Dim strSQLChange2 As String

Dim cmdChange2 As ADODB.Command

Dim strSQLChange3 As String

Dim cmdChange3 As ADODB.Command

Dim errLoop As ADODB.Error

' ãä / ÍÓÇÈ ãÐßæÑíä

' ãä / ÍÓÇÈ ãÔÊÑíÇÊ

strSQLChange = "UPDATE accounts SET curbal_dr = curbal_dr + " & _

(Me!Total) * Typ & " where acc_code = 3104"

' ãä / ÍÓÇÈ ãÕÑæÝÇÊ ãÔÊÑíÇÊ äÞÏíÉ

strSQLChange3 = "UPDATE accounts SET curbal_dr = curbal_dr + " & _

(Me.nakl_cost) * Typ & " where acc_code = 3105"

' Çáì / ÍÓÇÈ ãÐßæÑíä

' Çáì / ÍÓÇÈ äÞÏíÉ

strSQLChange1 = "UPDATE accounts SET curbal_cr = curbal_cr + " & _

(Me!Total - Me!Discount + Me.nakl_cost) * Typ & " where acc_code = 1101"

' Çáì / ÍÓÇÈ ÎÕã ãßÊÓÈ

strSQLChange2 = "UPDATE accounts SET curbal_cr = curbal_cr + " & _

(Me!Discount) * Typ & " where acc_code = 4105"

' Open connection.

Set cmdChange = New ADODB.Command

Set cmdChange.ActiveConnection = CurrentProject.Connection

cmdChange.CommandText = strSQLChange

cmdChange.Execute

' Open connection.

Set cmdChange1 = New ADODB.Command

Set cmdChange1.ActiveConnection = CurrentProject.Connection

cmdChange1.CommandText = strSQLChange1

cmdChange1.Execute

' Open connection.

Set cmdChange2 = New ADODB.Command

Set cmdChange2.ActiveConnection = CurrentProject.Connection

cmdChange2.CommandText = strSQLChange2

cmdChange2.Execute

' Open connection.

Set cmdChange3 = New ADODB.Command

Set cmdChange3.ActiveConnection = CurrentProject.Connection

cmdChange3.CommandText = strSQLChange3

cmdChange3.Execute

Exit Sub

Err_Execute:

' Notify user of any errors that result from

' executing the query.

Handle_Errors_ADO "", Err.Number, Err.Description

' Resume Next

End Sub

Public Sub update_2201yawmeya(Typ As Integer)

Dim strSQLChange As String

Dim cmdChange As ADODB.Command

Dim strSQLChange1 As String

Dim cmdChange1 As ADODB.Command

Dim strSQLChange2 As String

Dim cmdChange2 As ADODB.Command

Dim strSQLChange3 As String

Dim cmdChange3 As ADODB.Command

Dim strSQLChange4 As String

Dim cmdChange4 As ADODB.Command

Dim errLoop As ADODB.Error

'ãä ÍÓÇÈ ãÐßæÑíä

'----------------

' ãä / ÍÓÇÈ ãÔÊÑíÇÊ

strSQLChange = "UPDATE accounts SET curbal_dr = curbal_dr + " & _

(Me!Total) * Typ & " where acc_code = 3104"

' ãä / ãÕÑæÝÇÊ ãÔÊÑíÇÊ äÞÏíÉ

strSQLChange2 = "UPDATE accounts SET curbal_dr = curbal_dr + " & _

(Me!nakl_cost) * Typ & " where acc_code = 3105"

'Çáì ÍÓÇÈ ãÐßæÑíä

'----------------

'Çáì / ÍÓÇÈ ÑÃÓ ÇáãÇá

strSQLChange1 = "UPDATE accounts SET curbal_cr = curbal_cr + " & _

(Me!Total - Me!Discount) * Typ & " where acc_code = 2201"

'Çáì / ÍÓÇÈ äÞÏíÉ

strSQLChange3 = "UPDATE accounts SET curbal_cr = curbal_cr + " & _

(Me!nakl_cost) * Typ & " where acc_code = 1101"

' Çáì / ÍÓÇÈ ÎÕã ãßÊÓÈ

strSQLChange4 = "UPDATE accounts SET curbal_cr = curbal_cr + " & _

(Me!Discount) * Typ & " where acc_code = 4105"

' Open connection.

Set cmdChange = New ADODB.Command

Set cmdChange.ActiveConnection = CurrentProject.Connection

cmdChange.CommandText = strSQLChange

cmdChange.Execute

' Open connection.

Set cmdChange1 = New ADODB.Command

Set cmdChange1.ActiveConnection = CurrentProject.Connection

cmdChange1.CommandText = strSQLChange1

cmdChange1.Execute

' Open connection.

Set cmdChange2 = New ADODB.Command

Set cmdChange2.ActiveConnection = CurrentProject.Connection

cmdChange2.CommandText = strSQLChange2

cmdChange2.Execute

' Open connection.

Set cmdChange3 = New ADODB.Command

Set cmdChange3.ActiveConnection = CurrentProject.Connection

cmdChange3.CommandText = strSQLChange3

cmdChange3.Execute

' Open connection.

Set cmdChange4 = New ADODB.Command

Set cmdChange4.ActiveConnection = CurrentProject.Connection

cmdChange4.CommandText = strSQLChange4

cmdChange4.Execute

Exit Sub

Err_Execute:

' Notify user of any errors that result from

' executing the query.

Handle_Errors_ADO "", Err.Number, Err.Description

' Resume Next

End Sub

Private Sub cmd_add_Click()

On Error GoTo Err_cmd_add_Click

add_button

Me.CmdPost.Enabled = False

Me.CmdUnPost.Enabled = False

Me.cmdprv.Enabled = False

DoCmd.GoToRecord , , acNewRec

'=======================================

Dim maxval As Long

Dim strSQL As String

Dim rst As New ADODB.Recordset

strSQL = "SELECT max(ser) FROM Trans"

rst.Open strSQL, CurrentProject.Connection, _

adOpenKeyset, adLockOptimistic

rst.MoveFirst

maxval = IIf(IsNull(rst.Fields(0)), 0, rst.Fields(0))

Me.SER = maxval + 1

rst.Close

Me.TranDate = Format(date, "yyyy/mm/dd")

DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

With Me

.AllowAdditions = False

.AllowEdits = True

.AllowDeletions = False

.PurInvDt.Form.AllowEdits = False

.PurInvDt.Form.AllowAdditions = True

.PurInvDt.Form.AllowDeletions = False

End With

'================

Exit_cmd_add_Click:

Me.TranNo.SetFocus

Exit Sub

Err_cmd_add_Click:

If Err.Number = 13 Then

' Me.TranNo = 1

Me.SER = 1

Resume Exit_cmd_add_Click

End If

If Err.Number = 2499 Or Err.Number = 3201 Or Err.Number = 3314 Or Err.Number = 2105 Then

Resume Exit_cmd_add_Click

End If

Handle_Errors_ADO "", Err.Number, Err.Description

Resume Exit_cmd_add_Click

End Sub

Private Sub cmd_mod_Click()

On Error GoTo Err_cmd_mod_Click

Me.CmdPost.Enabled = False

Me.CmdUnPost.Enabled = False

Me.cmdprv.Enabled = False

If Not Me!Posted Then

mod_button

Me.CmdPost.Enabled = False

Me.CmdUnPost.Enabled = False

Me.cmdprv.Enabled = False

Else

Me.CmdPost.Enabled = True

Me.CmdUnPost.Enabled = True

Me.cmdprv.Enabled = True

Style = vbOKOnly

Title = " ãßÊÈ ÇáÊæÍíÏ"

If MsgBox(" ÛíÑ ãÓãæÍ ÈÇáÊÚÏíá áÇä ÇáÝÇÊæÑÉ ãÑÍáÉ ", Style, Title) = vbOK Then

End If

End If

Exit_cmd_mod_Click:

Exit Sub

Err_cmd_mod_Click:

Handle_Errors_ADO "", Err.Number, Err.Description

Resume Exit_cmd_mod_Click

End Sub

Private Sub cmdsaverec_Click()

On Error GoTo Err_cmdsaverec_Click

CALC_INV_TOT

DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

Exit_cmdsaverec_Click:

user_licence

no_add_mod_del

' Me.cmdfirstrec.SetFocus

' Me.cmdsaverec.Enabled = False

Me.cmd_undo.Enabled = False

Me.cmd_Undo_sub.Enabled = False

Me.CmdPost.Enabled = True

Me.CmdUnPost.Enabled = True

Me.cmdprv.Enabled = True

' Me.PurInvDt.SetFocus

Me.cmd_add_sub_tr_no.SetFocus

Exit Sub

Err_cmdsaverec_Click:

If Err.Number = 2046 Or Err.Number = 91 Or Err.Number = 20 Then

Resume Exit_cmdsaverec_Click

End If

Handle_Errors_ADO "", Err.Number, Err.Description

' Resume Exit_cmdsaverec_Click

End Sub

Private Sub cmd_undo_Click()

On Error GoTo Err_cmd_undo_Click

Set GENERAL.PRVCTRL = Screen.PreviousControl

Screen.PreviousControl.SetFocus

Set GENERAL.GLFRM = Me

If GENERAL.PRVCTRL.NAME = "PurInvDt" Then

Me.PurInvDt.SetFocus

DoCmd.RunCommand acCmdUndo

GoTo xx

End If

If Me.cmd_mod.Enabled = True Then

' Me.SetFocus

DoCmd.RunCommand acCmdUndo

GoTo xx

End If

If Me.cmd_add.Enabled = True Then

DoCmd.SetWarnings False

Style = vbYesNo 'vbOKCancel

Title = " ãßÊÈ ÇáÊæÍíÏ" ' Define title.

If MsgBox(" åÜÜÜá ÊÑíÜÜÜÏ ÍÜÜÜÐÝ ÇáÝÇÊæÑÉ ÇáÍÇáíÉ ", Style, Title) = _

vbYes Then

DeleteRec1 Me, "TranNo = " & CStr(Me!TranNo)

user_licence

no_add_mod_del

Me.cmdfirstrec.SetFocus

Me.cmdsaverec.Enabled = False

Me.cmd_undo.Enabled = False

Me.cmd_Undo_sub.Enabled = False

DoCmd.GoToRecord , , acFirst

Else

add_button

Me.cmdfirstrec.SetFocus

Me.cmdsaverec.Enabled = False

Me.cmd_undo.Enabled = False

Me.cmd_Undo_sub.Enabled = False

End If

End If

DoCmd.SetWarnings True

xx:

Exit_cmd_undo_Click:

Exit Sub

Err_cmd_undo_Click:

If Err.Number = 2046 Or Err.Number = 2105 Or Err.Number = 3709 Then

Resume Exit_cmd_undo_Click

End If

Handle_Errors_ADO "", Err.Number, Err.Description

Resume Exit_cmd_undo_Click

End Sub

Private Sub cmd_fresh_Click()

On Error GoTo xx

GLFRM.Filter = ""

GLFRM.FilterOn = False

DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70

user_licence

no_add_mod_del

Me.cmdsaverec.Enabled = False

Me.cmd_undo.Enabled = False

Me.cmd_Undo_sub.Enabled = False

Me.CmdPost.Enabled = True

Me.CmdUnPost.Enabled = True

' Me.cmdprv.Enabled = False

xx:

End Sub

Private Sub cmdfirstrec_Click()

On Error GoTo Err_cmdfirstrec_Click

DoCmd.GoToRecord , , acFirst

Exit_cmdfirstrec_Click:

user_licence

no_add_mod_del

Me.cmdsaverec.Enabled = False

Me.cmd_undo.Enabled = False

Me.cmd_Undo_sub.Enabled = False

Me.CmdPost.Enabled = True

Me.CmdUnPost.Enabled = True

' Me.cmdprv.Enabled = False

Exit Sub

Err_cmdfirstrec_Click:

Handle_Errors_ADO "", Err.Number, Err.Description

Resume Exit_cmdfirstrec_Click

End Sub

Private Sub cmdlastrec_Click()

On Error GoTo Err_cmdlastrec_Click

DoCmd.GoToRecord , , acLast

Exit_cmdlastrec_Click:

user_licence

no_add_mod_del

Me.cmdsaverec.Enabled = False

Me.cmd_undo.Enabled = False

Me.cmd_Undo_sub.Enabled = False

Me.CmdPost.Enabled = True

Me.CmdUnPost.Enabled = True

' Me.cmdprv.Enabled = False

Exit Sub

Err_cmdlastrec_Click:

Handle_Errors_ADO "", Err.Number, Err.Description

Resume Exit_cmdlastrec_Click

End Sub

Private Sub cmdprevrec_Click()

On Error GoTo Err_cmdprevrec_Click

DoCmd.GoToRecord , , acPrevious

Me.cmdnextrec.Enabled = True

Exit_cmdprevrec_Click:

user_licence

no_add_mod_del

Me.cmdsaverec.Enabled = False

Me.cmd_undo.Enabled = False

Me.cmd_Undo_sub.Enabled = False

Me.CmdPost.Enabled = True

Me.CmdUnPost.Enabled = True

' Me.cmdprv.Enabled = False

Exit Sub

Err_cmdprevrec_Click:

Handle_Errors_ADO "", Err.Number, Err.Description

Resume Exit_cmdprevrec_Click

End Sub

Private Sub cmdnextrec_Click()

On Error GoTo Err_cmdnextrec_Click

DoCmd.GoToRecord , , acNext

Me.cmdprevrec.Enabled = True

Exit_cmdnextrec_Click:

user_licence

no_add_mod_del

Me.cmdsaverec.Enabled = False

Me.cmd_undo.Enabled = False

Me.cmd_Undo_sub.Enabled = False

Me.CmdPost.Enabled = True

Me.CmdUnPost.Enabled = True

' Me.cmdprv.Enabled = False

Exit Sub

Err_cmdnextrec_Click:

Handle_Errors_ADO "", Err.Number, Err.Description

' Resume Exit_cmdnextrec_Click

End Sub

Private Sub cmdexitrec_Click()

On Error GoTo Err_cmdexitrec_Click

DoCmd.Close

Exit_cmdexitrec_Click:

Exit Sub

Err_cmdexitrec_Click:

Handle_Errors_ADO "", Err.Number, Err.Description

Resume Exit_cmdexitrec_Click

End Sub

Private Sub cmdfindrec_Click()

On Error GoTo Err_cmdfindrec_Click

Set GENERAL.PRVCTRL = Screen.PreviousControl

Screen.PreviousControl.SetFocus

Set GENERAL.GLFRM = Me

If GENERAL.PRVCTRL.NAME = "PurInvDt" Then

'-------------------------------------------------

Msg = "ÛíÑ ãÓãæÍ ÈÇáÈÍË Ýì ÇÕäÇÝ ÇáÝÇÊæÑÉ .. ÇáÈÍË ÝÞØ Ýì ÑÞã ÇáÝÇÊæÑÉ æ ÇáÊÇÑíÎ "

Style = vbOKOnly

Title = " ãßÊÈ ÇáÊæÍíÏ "

Dim s As Integer

s = 10 ' ÚÏÏ ÇáËæÇäí

mResult = MsgBoxPause(hwnd, Msg, Title, Style, s)

'-------------------------------------------------

Resume Exit_cmdfindrec_Click

End If

DoCmd.OpenForm "frm_find", acNormal, , , , acDialog

Exit_cmdfindrec_Click:

user_licence

no_add_mod_del

Me.cmdsaverec.Enabled = False

Me.cmd_undo.Enabled = False

Me.cmd_Undo_sub.Enabled = False

Me.CmdPost.Enabled = True

Me.CmdUnPost.Enabled = True

'Me.cmdprv.Enabled = False

Exit Sub

Err_cmdfindrec_Click:

If Err.Number = 2455 Then

GLFRM.Filter = ""

GLFRM.FilterOn = False

DoCmd.DoMenuItem acFormBar, acRecordsMenu, 5, , acMenuVer70

Resume Exit_cmdfindrec_Click

End If

Handle_Errors_ADO "", Err.Number, Err.Description

Resume Exit_cmdfindrec_Click

End Sub

Private Sub cmddelrec_Click()

On Error GoTo Err_cmddelrec_Click

If Me!Posted Then

Style = vbOKOnly 'vbOKCancel

Title = " ãßÊÈ ÇáÊæÍíÏ" ' Define title.

If MsgBox(" åÐå ÇáÝÇÊæÑÉ Êã ÊÑÍíáåÇ .. áÇáÛÇÁ ÇáÝÇÊæÑÉ Þã ÈÇáÛÇÁ ÇáÊÑÍíá ", Style, Title) = _

vbOK Then

End If

Else

With Me

.AllowAdditions = False

.AllowEdits = False

.AllowDeletions = True

.PurInvDt.Form.AllowAdditions = False

.PurInvDt.Form.AllowEdits = False

.PurInvDt.Form.AllowDeletions = True

End With

'===================================================================

Style = vbYesNo 'vbOKCancel

Title = " ãßÊÈ ÇáÊæÍíÏ" ' Define title.

If MsgBox(" åÜÜá ÊÑíÜÏ ÍÜÜÜÐÝ ÇáÝÇÊæÑÉ ÇáÍÜÜÇáíÉ ", Style, Title) = _

vbYes Then

DeleteRec1 Me, "ser = " & CStr(Me!SER)

DoCmd.GoToRecord , , acLast

End If

'===================================================================

End If

Exit_cmddelrec_Click:

user_licence

no_add_mod_del

Me.cmdsaverec.Enabled = False

Me.cmd_undo.Enabled = False

Me.cmd_Undo_sub.Enabled = False

Me.CmdPost.Enabled = True

Me.CmdUnPost.Enabled = True

'Me.cmdprv.Enabled = False

Exit Sub

Err_cmddelrec_Click:

If Err.Number = 2105 Or Err.Number = 20 Then

Resume Exit_cmddelrec_Click

End If

Handle_Errors_ADO "", Err.Number, Err.Description

Resume Exit_cmddelrec_Click

End Sub

'=========================================================

Sub display_all_button()

On Error GoTo xx

Me.cmdsaverec.Enabled = True

Me.cmd_undo.Enabled = True

Me.cmd_add.Enabled = True

Me.cmd_mod.Enabled = True

Me.cmdfindrec.Enabled = True

Me.cmd_fresh.Enabled = True

Me.cmddelrec.Enabled = True

Me.cmdexitrec.Enabled = True

Me.cmdfirstrec.Enabled = True

Me.cmdlastrec.Enabled = True

Me.cmdnextrec.Enabled = True

Me.cmdprevrec.Enabled = True

Me.cmd_add_sub_tr_no.Enabled = True

Me.cmd_delsubrec.Enabled = True

Me.cmd_Undo_sub.Enabled = True

xx:

' Handle_Errors_ADO "", Err.Number, Err.Description

End Sub

Sub no_add_mod_del()

On Error GoTo Err_no_add_mod_del

' not allow add - mod -- dis

With Me

.AllowAdditions = False

.AllowEdits = False

.AllowDeletions = False

.PurInvDt.Form.AllowAdditions = False

.PurInvDt.Form.AllowEdits = False

.PurInvDt.Form.AllowDeletions = False

End With

Exit_no_add_mod_del_Click:

Exit Sub

Err_no_add_mod_del:

If Err.Number = 2455 Or Err.Number = 3709 Or Err.Number = 3314 Then

Resume Exit_no_add_mod_del_Click

Else

Handle_Errors_ADO "", Err.Number, Err.Description

Resume Exit_no_add_mod_del_Click

End If

End Sub

Sub add_button()

On Error GoTo xx

'when press add buttom

Me.cmdsaverec.Enabled = True

Me.cmd_undo.Enabled = True

Me.cmd_add.Enabled = True

Me.cmd_add_sub_tr_no.Enabled = False

Me.cmd_Undo_sub.Enabled = False

Me.cmd_mod.Enabled = False

Me.cmdfindrec.Enabled = False

Me.cmd_fresh.Enabled = False

Me.cmddelrec.Enabled = False

Me.cmd_delsubrec.Enabled = False

Me.cmdexitrec.Enabled = False

Me.cmdfirstrec.Enabled = False

Me.cmdlastrec.Enabled = False

Me.cmdnextrec.Enabled = False

Me.cmdprevrec.Enabled = False

With Me

.AllowAdditions = True

.AllowEdits = True

.AllowDeletions = False

.PurInvDt.Form.AllowAdditions = True

.PurInvDt.Form.AllowDeletions = False

.PurInvDt.Form.AllowEdits = True

End With

xx:

' Handle_Errors_ADO "", Err.Number, Err.Description

End Sub

Sub mod_button()

On Error GoTo xx

Me.cmdsaverec.Enabled = True

Me.cmd_undo.Enabled = True

Me.cmd_mod.Enabled = True

Me.cmd_Undo_sub.Enabled = False

Me.cmd_add_sub_tr_no.Enabled = False

Me.cmd_delsubrec.Enabled = False

Me.cmd_add.Enabled = False

Me.cmdfindrec.Enabled = False

Me.cmd_fresh.Enabled = False

Me.cmddelrec.Enabled = False

Me.cmdexitrec.Enabled = False

Me.cmdfirstrec.Enabled = False

Me.cmdlastrec.Enabled = False

Me.cmdnextrec.Enabled = False

Me.cmdprevrec.Enabled = False

With Me

.AllowAdditions = False

.AllowEdits = True

.AllowDeletions = False

.PurInvDt.Form.AllowEdits = True

.PurInvDt.Form.AllowAdditions = False

.PurInvDt.Form.AllowDeletions = False

End With

xx:

' Handle_Errors_ADO "", Err.Number, Err.Description

End Sub

Sub user_licence()

On Error GoTo xx

Dim SER1 As Integer 'ßæÏ ãÓÊÎÏã

Dim FRM1 As Integer 'ÇÖÇÝÉ

Dim FRM2 As Integer 'ÊÚÏíá

Dim FRM3 As Integer 'ÚÑÖ

Dim FRM4 As Integer 'ÍÐÝ

Dim FRM5 As Integer 'ØÈÇÚÉ

Dim strSQL As String

Dim rst As New ADODB.Recordset

strSQL = "select * from MsysFRMsu"

rst.Open strSQL, CurrentProject.Connection, _

adOpenKeyset, adLockOptimistic

rst.MoveFirst

SER1 = rst!SERu

FRM1 = rst!FRM1u

FRM2 = rst!FRM2u

FRM3 = rst!FRM3u

FRM4 = rst!FRM4u

FRM5 = rst!FRM5u

rst.Close

'ÍÝÙ æ ÊÑÇÌÚ

'-----------

If FRM1 = 1 Or FRM2 = 1 Or FRM4 = 1 Then

Me.cmdsaverec.Enabled = True

Me.cmd_undo.Enabled = True

Me.cmd_Undo_sub.Enabled = True

Else

Me.cmdsaverec.Enabled = False

Me.cmd_undo.Enabled = False

Me.cmd_Undo_sub.Enabled = False

End If

If FRM1 = 1 Or FRM2 = 1 Or FRM3 = 1 Or FRM4 = 1 Or FRM5 = 1 Then

Me.cmdexitrec.Enabled = True

End If

'ÚÑÖ

If FRM3 = 1 Then

Me.cmdfindrec.Enabled = True

Me.cmd_fresh.Enabled = True

Me.cmdfirstrec.Enabled = True

Me.cmdlastrec.Enabled = True

Me.cmdnextrec.Enabled = True

Me.cmdprevrec.Enabled = True

Else

Me.cmdfindrec.Enabled = False

Me.cmd_fresh.Enabled = False

Me.cmdfirstrec.Enabled = False

Me.cmdlastrec.Enabled = False

Me.cmdnextrec.Enabled = False

Me.cmdprevrec.Enabled = False

End If

'ÇÖÇÝÉ

If FRM1 = 1 Then

Me.cmd_add.Enabled = True

Me.cmd_add_sub_tr_no.Enabled = True

Else

Me.cmd_add.Enabled = False

Me.cmd_add_sub_tr_no.Enabled = False

End If

'ÊÚÏíá

If FRM2 = 1 Then

Me.cmd_mod.Enabled = True

Me.CmdPost.Enabled = True

Me.CmdUnPost.Enabled = True

Me.cmdprv.Enabled = True

Else

Me.cmd_mod.Enabled = False

Me.CmdPost.Enabled = True

Me.CmdUnPost.Enabled = True

Me.cmdprv.Enabled = False

End If

'ÍÐÝ

If FRM4 = 1 Then

Me.cmddelrec.Enabled = True

Me.cmd_delsubrec.Enabled = True

Else

Me.cmddelrec.Enabled = False

Me.cmd_delsubrec.Enabled = False

End If

'ØÈÇÚÉ

If FRM5 = 1 Then

Me.cmdprv.Enabled = True

Else

Me.cmdprv.Enabled = False

End If

xx:

' Handle_Errors_ADO "", Err.Number, Err.Description

End Sub

'ÊÍÑíß ÇáÔÇÔÉ È 6 ØÑÞ

Private Sub Form_Open(Cancel As Integer)

On Error GoTo Err_Form_Open_Click

Set Anim = New clsFormAnimate

Set Anim.AnimationForm = Me

Anim.FormHeight = 8500

Anim.FormWidth = 12800

Anim.FormTop = 90

Anim.FormLeft = 150

' Comment out line below if you

' want Animation when closing the Form.

Anim.NoCloseAnimation = True

' Uncomment if you do NOT want

' Animation when the Form opens

'Anim.NoOpenAnimation = True

'=========================

Dim rstdt As New ADODB.Recordset

Dim SQLstr2 As String

SQLstr2 = "select * from school1"

rstdt.Open SQLstr2, CurrentProject.Connection, _

adOpenKeyset, adLockOptimistic

rstdt.MoveFirst

Me.school_name = rstdt!school_name

rstdt.Close

'=========================

Exit_Form_Open_Click:

Exit Sub

Err_Form_Open_Click:

Handle_Errors_ADO "", Err.Number, Err.Description

Resume Exit_Form_Open_Click

End Sub

'ÊÛííÑ ÍÌã ÇáÔÇÔÉ

Private Sub Form_Resize()

On Error GoTo xx

Me.Repaint

xx:

' Handle_Errors_ADO "", Err.Number, Err.Description

End Sub

Private Sub cmdprv_Click()

On Error GoTo Err_cmdprv_Click

Dim stDocName As String

stDocName = "rep_purinv"

DoCmd.OpenReport stDocName, acPreview

Exit_cmdprv_Click:

Exit Sub

Err_cmdprv_Click:

Handle_Errors_ADO "", Err.Number, Err.Description

Resume Exit_cmdprv_Click

End Sub

Private Sub cmd_add_sub_tr_no_Click()

On Error GoTo Err_cmd_add_sub_tr_no_Click

'----------------------------------------

If Me!Posted Then

Style = vbOKOnly 'vbOKCancel

Title = " ãßÊÈ ÇáÊæÍíÏ" ' Define title.

If MsgBox(" åÐå ÇáÝÇÊæÑÉ Êã ÊÑÍíáåÇ .. áÇÖÇÝÉ ÕäÝ ÌÏíÏ Þã ÈÇáÛÇÁ ÇáÊÑÍíá ", Style, Title) = _

vbOK Then

End If

Else

Me.cmd_undo.Enabled = False

Me.cmd_add.Enabled = False

Me.cmd_mod.Enabled = False

Me.cmdfindrec.Enabled = False

Me.cmd_fresh.Enabled = False

Me.cmddelrec.Enabled = False

Me.cmdexitrec.Enabled = False

Me.cmdfirstrec.Enabled = False

Me.cmdlastrec.Enabled = False

Me.cmdnextrec.Enabled = False

Me.cmdprevrec.Enabled = False

Me.cmd_delsubrec.Enabled = False

Me.cmdsaverec.Enabled = True

Me.cmd_add_sub_tr_no.Enabled = True

Me.cmd_Undo_sub.Enabled = True

Me.CmdPost.Enabled = False

Me.CmdUnPost.Enabled = False

Me.cmdprv.Enabled = False

'----------------------------------------

With Me

.AllowAdditions = False

.AllowEdits = True

.AllowDeletions = False

.PurInvDt.Form.AllowEdits = True

.PurInvDt.Form.AllowAdditions = True

.PurInvDt.Form.AllowDeletions = False

End With

Me.PurInvDt.Enabled = True

Me.PurInvDt.SetFocus

DoCmd.GoToRecord , , acNewRec

Me!PurInvDt.Form!seq.SetFocus

End If

Exit_cmd_add_sub_tr_no_Click:

Exit Sub

Err_cmd_add_sub_tr_no_Click:

Handle_Errors_ADO "", Err.Number, Err.Description

Resume Exit_cmd_add_sub_tr_no_Click

End Sub

Private Sub cmd_delsubrec_Click()

On Error GoTo Err_cmd_delsubrec_Click

If Me!Posted Then

Style = vbOKOnly 'vbOKCancel

Title = " ãßÊÈ ÇáÊæÍíÏ" ' Define title.

If MsgBox(" åÐå ÇáÝÇÊæÑÉ Êã ÊÑÍíáåÇ .. áÍÐÝ ÕäÝ Þã ÈÇáÛÇÁ ÇáÊÑÍíá ", Style, Title) = _

vbOK Then

End If

Else

'----------------------------------------

Me.cmd_undo.Enabled = False

Me.cmd_add.Enabled = False

Me.cmd_mod.Enabled = False

Me.cmdfindrec.Enabled = False

Me.cmd_fresh.Enabled = False

Me.cmddelrec.Enabled = False

Me.cmdexitrec.Enabled = False

Me.cmdfirstrec.Enabled = False

Me.cmdlastrec.Enabled = False

Me.cmdnextrec.Enabled = False

Me.cmdprevrec.Enabled = False

Me.cmd_add_sub_tr_no.Enabled = False

Me.cmd_Undo_sub.Enabled = False

Me.cmdsaverec.Enabled = True

Me.cmd_delsubrec.Enabled = True

'-------------------------------

With Me

.AllowAdditions = False

.AllowEdits = True

.AllowDeletions = False

.PurInvDt.Form.AllowEdits = True

.PurInvDt.Form.AllowAdditions = False

.PurInvDt.Form.AllowDeletions = True

End With

'----------------------------

Me.PurInvDt.SetFocus

Style = vbYesNo 'vbOKCancel

Title = " ãßÊÈ ÇáÊæÍíÏ" ' Define title.

If MsgBox(" åÜÜÜá ÊÑíÜÜÜÏ ÍÜÜÜÜÐÝ ÇáÕäÝ ÇáÍÇáì ", Style, Title) = _

vbYes Then

DoCmd.SetWarnings False

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70

user_licence

no_add_mod_del

Else

user_licence

no_add_mod_del

End If

DoCmd.SetWarnings True

End If

Exit_Err_cmd_delsubrec_Click:

Me.cmd_undo.Enabled = False

Me.cmd_add.Enabled = False

Me.cmd_mod.Enabled = False

Me.cmdfindrec.Enabled = False

Me.cmd_fresh.Enabled = False

Me.cmddelrec.Enabled = False

Me.cmdexitrec.Enabled = False

Me.cmdfirstrec.Enabled = False

Me.cmdlastrec.Enabled = False

Me.cmdnextrec.Enabled = False

Me.cmdprevrec.Enabled = False

Me.cmd_add_sub_tr_no.Enabled = False

Me.cmd_Undo_sub.Enabled = False

Me.cmdsaverec.Enabled = True

Me.cmd_delsubrec.Enabled = True

Me.cmdsaverec.SetFocus

Exit Sub

Err_cmd_delsubrec_Click:

If Err.Number = 2046 Or Err.Number = 3201 Or Err.Number = 3314 Or Err.Number = 2105 Then

Resume Exit_Err_cmd_delsubrec_Click

End If

Handle_Errors_ADO "", Err.Number, Err.Description

Resume Exit_Err_cmd_delsubrec_Click

End Sub

Private Sub cmd_Undo_sub_Click()

On Error GoTo Err_cmd_Undo_sub_Click

If Me.cmd_add_sub_tr_no.Enabled = True Then

DoCmd.SetWarnings False

Me.PurInvDt.SetFocus

Me.PurInvDt.Form.AllowEdits = True

Me.PurInvDt.Form.AllowDeletions = True

Style = vbYesNo 'vbOKCancel

Title = " ãßÊÈ ÇáÊæÍíÏ" ' Define title.

If MsgBox(" åÜÜÜá ÊÑíÜÜÜÏ ÍÜÜÜÐÝ ÇáÕäÝ ÇáÍÇáì ¿ ", Style, Title) = _

vbYes Then

DoCmd.SetWarnings False

DoCmd.DoMenuItem acFormBar, acEditMenu, 8, , acMenuVer70

DoCmd.DoMenuItem acFormBar, acEditMenu, 6, , acMenuVer70

DoCmd.SetWarnings True

Me.cmd_undo.Enabled = False

Me.cmd_add.Enabled = False

Me.cmd_mod.Enabled = False

Me.cmdfindrec.Enabled = False

Me.cmd_fresh.Enabled = False

Me.cmddelrec.Enabled = False

Me.cmdexitrec.Enabled = False

Me.cmdfirstrec.Enabled = False

Me.cmdlastrec.Enabled = False

Me.cmdnextrec.Enabled = False

Me.cmdprevrec.Enabled = False

Me.cmdsaverec.Enabled = True

Me.cmd_delsubrec.Enabled = False

Me.cmd_Undo_sub.Enabled = True

'----------------------------------------

Else

Me.cmd_undo.Enabled = False

Me.cmd_add.Enabled = False

Me.cmd_mod.Enabled = False

Me.cmdfindrec.Enabled = False

Me.cmd_fresh.Enabled = False

Me.cmddelrec.Enabled = False

Me.cmdexitrec.Enabled = False

Me.cmdfirstrec.Enabled = False

Me.cmdlastrec.Enabled = False

Me.cmdnextrec.Enabled = False

Me.cmdprevrec.Enabled = False

Me.cmd_delsubrec.Enabled = False

Me.cmdsaverec.Enabled = True

Me.cmd_add_sub_tr_no.Enabled = True

Me.cmd_Undo_sub.Enabled = True

With Me

.AllowAdditions = False

.AllowEdits = True

.AllowDeletions = False

.PurInvDt.Form.AllowEdits = True

.PurInvDt.Form.AllowAdditions = True

.PurInvDt.Form.AllowDeletions = False

End With

Exit Sub

End If

End If

Exit_cmd_Undo_sub_Click:

user_licence

no_add_mod_del

Me.cmdfirstrec.SetFocus

Me.cmdsaverec.Enabled = False

Me.cmd_undo.Enabled = False

Me.cmd_Undo_sub.Enabled = False

Me.CmdPost.Enabled = True

Me.CmdUnPost.Enabled = True

Me.cmdprv.Enabled = False

Me.PurInvDt.SetFocus

Exit Sub

Err_cmd_Undo_sub_Click:

If Err.Number = 2046 Or Err.Number = 0 Then

Resume Exit_cmd_Undo_sub_Click

End If

Handle_Errors_ADO "", Err.Number, Err.Description

' Screen.PreviousControl.SetFocus

Resume Exit_cmd_Undo_sub_Click

End Sub

Private Sub Stk_Ser_Enter()

Me!STK_SER.Requery

End Sub

Private Sub Stk_Ser_KeyDown(KeyCode As Integer, Shift As Integer)

Me.STK_SER.Dropdown

End Sub

Private Sub TranDate_Exit(Cancel As Integer)

On Error GoTo Err_TranDate_Click

If Len(Me.TranDate.Value) <> 10 Then

Me.TranDate.InputMask = "00/00/0000"

Me.TranDate.Format = "yyyy/mm/dd"

End If

Exit_TranDate_Click:

Exit Sub

Err_TranDate_Click:

If Err.Number = 2424 Then

Resume Exit_TranDate_Click

End If

Handle_Errors_ADO "", Err.Number, Err.Description

Resume Exit_TranDate_Click

End Sub

Sub DeleteRec1(frm As Form, FindStr As String)

On Error GoTo xx

Dim rst As Recordset

DoCmd.SetWarnings False

Set rst = frm.RecordsetClone

rst.FindFirst FindStr

rst.Delete

rst.Close

xx:

' Handle_Errors_ADO "", Err.Number, Err.Description

End Sub

Private Sub Vnd_Cust_Enter()

Me!Vnd_Cust.Requery

End Sub

Private Sub Vnd_Cust_KeyDown(KeyCode As Integer, Shift As Integer)

Me.Vnd_Cust.Dropdown

End Sub

اخي الفاضل

استبدل الأكواد القديمة المطابقة لهذه الأكواد بهذه الجديده

Sub CALC_INV_TOT()
On Error GoTo xx
Dim TOT As Double

Dim strSQL As String
strSQL = "SELECT sum(TransDt.Qty*TransDt.PRICE) " & _
" FROM Trans INNER JOIN TransDt ON Trans.Ser = TransDt.Tran_Ser WHERE Trans.Ser=" & Me!SER

Dim rst As New ADODB.Recordset
rst.Open strSQL, CurrentProject.Connection, _
adOpenKeyset, adLockOptimistic

If Not rst.BOF And Not rst.EOF Then   'هذا هو السطر الذي تم اضافته للكود
rst.MoveFirst
TOT = rst.Fields(0)
Me!Total = TOT

rst.Close
Exit Sub
xx:
' Handle_Errors_ADO "", Err.Number, Err.Description

If Err.Number = 2448 Then
Exit Sub
Else
Me!Total = 0
End If
End If
End Sub

Private Sub cmd_add_Click()
On Error GoTo Err_cmd_add_Click

add_button

Me.CmdPost.Enabled = False
Me.CmdUnPost.Enabled = False
Me.cmdprv.Enabled = False

DoCmd.GoToRecord , , acNewRec
'=======================================
Dim maxval As Long
Dim strSQL As String
Dim rst As New ADODB.Recordset

strSQL = "SELECT max(ser) FROM Trans"
rst.Open strSQL, CurrentProject.Connection, _
adOpenKeyset, adLockOptimistic

If Not rst.BOF And Not rst.EOF Then   'هذا هو السطر الذي تم اضافته للكود
rst.MoveFirst
maxval = IIf(IsNull(rst.Fields(0)), 0, rst.Fields(0))
Me.SER = maxval + 1

rst.Close
end if
Me.TranDate = Format(date, "yyyy/mm/dd")

DoCmd.DoMenuItem acFormBar, acRecordsMenu, acSaveRecord, , acMenuVer70

With Me
.AllowAdditions = False
.AllowEdits = True
.AllowDeletions = False
.PurInvDt.Form.AllowEdits = False
.PurInvDt.Form.AllowAdditions = True
.PurInvDt.Form.AllowDeletions = False
End With

'================

Exit_cmd_add_Click:

Me.TranNo.SetFocus

Exit Sub

Err_cmd_add_Click:

If Err.Number = 13 Then
' Me.TranNo = 1
Me.SER = 1
Resume Exit_cmd_add_Click
End If
If Err.Number = 2499 Or Err.Number = 3201 Or Err.Number = 3314 Or Err.Number = 2105 Then
Resume Exit_cmd_add_Click
End If

Handle_Errors_ADO "", Err.Number, Err.Description
Resume Exit_cmd_add_Click
End Sub

بالتوفيق

للاسف لم يتغير الوضع برجاء مساعدتى ضرورى

معلش انا عارف انى متعب

بجد انا تعبت ومش عارف اوصل لحل

ساعديتى علشان خاطر ربنا

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

أخي الكريم حاول استبدال التعليمة التالية في محرر الفجوال لديك

While Not

بالتعليمة

DO While Not

أي أضف كلمة Do

وبدلا من Wend اكتب Loop

واعلمنا بالنتيجة

وإذا لم تفلح الطريقة الرجاء ذكر المكان المحدد الذي يظهر عنده الخطاً

سلامي لك وللجميع

للاسف برضه لم تنجح

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

اكيد حد هيوصل لحل المعضلة ديه و اتمنى ان تاخد الاخت زهرة الموضوع باهتمام

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

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

If Not Rs.EOF Then
Do while not rs.EOF
' process
Loop
Else
' No Data
End IF

سلامي لك وللجميع

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

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

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

وشكرا للجميع انى منتظر

اين انتم ياخبراء الاكسس

والله والله المشكلة ديه مسببه ليا ضغط نفسى رهيب

ارجوكم اعزك الله ان تساعدونى

henototy كتب:

اين انتم ياخبراء الاكسس

والله والله المشكلة ديه مسببه ليا ضغط نفسى رهيب

ارجوكم اعزك الله ان تساعدونى

اخي الفاضل

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

على حسب ما وضعت لنا من اكواد برمجية وضعنا لك الحلول المتوفره حسب رؤيتنا لما يوجد في الأكواد الخاصة بك

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

لذا حتى لا تصاب بالضغط النفسي اعاذك الله منه

كل ما عليك هو وضع قاعدة البيانات الخاصة بك فقط ودعنا نحن نتولى الباقي عنك وإن شاء الله نصل الى حل

بالتوفيق

اشكرك اخت زهرة

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

ولكن ليطمئن قلبى هل هذا ييمكن ان يكون سبب لهده الرسالة

رجاءا الاجابة

اخي الفاضل

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

لذا اذا كنت قد قمت بإزالة العلاقة وانتهت مشكلتك فلا يوجد مشكله

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

بالتوفيق

اشكرك جدا ياخت زهر بارك الله فيك وفى علمك

وليا رجاؤ اريد تصميم فاتورة بيع زى فاتورة بيع برنامج المحاسب المسلم الاصدار الاخير

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

وبجد كده يبقا كل اللى نفسى فيه اتحقق لحد الان

منتظر اجابتك او اجابة احد الاعضاء

الجمد لله كثيرا تم حل المشكلة كما قلت وايضا تم ايجاد الحل لتصنيف السعر للمنتج

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

برجاء اغلاق الموضوع لحل المشكلة

والسلام عليكم