ابو ياسين المشولي

ماخيبت ظنك استاذي ابو خليل ابوخليل
وصلت الى هذا فكانت النتيجه ممتازة وكانت المطلوب بانسبة لي
' On Error Resume Next Dim fdialog As Office.FileDialog Dim filepath As String Dim bb As String Dim sdialog As New WIA.CommonDialog Dim imagefile As WIA.imagefile On Error GoTo errorhandle bb = (Mid(CurrentDb("data1").Connect, InStrRev(CurrentDb("data1").Connect, "\") + 1, Len(CurrentDb("data1").Connect) - InStrRev(CurrentDb("data1").Connect, "\"))) Dim fso As Object Dim fldrname, fldrpath, FoldrPath As String FoldrPath = "Pictures" Set fso = CreateObject("scripting.filesystemobject") fldrpath = CurrentProject.Path & "\" & FoldrPath If Not fso.FolderExists(fldrpath) Then fso.CreateFolder (fldrpath) End If '================================== Set fdialog = Application.FileDialog(msoFileDialogSaveAs) If bb = "DATATAILORVATa" Then 'filepath = CurrentProject.Path & "\DATA\StPica" + "\" & nofatora & ".jpg" filepath = "\\WIN-GRM8M28FNLU\Tailor\DATA\StPica" + "\" & nofatora & ".jpg" ElseIf bb = "DATATAILORVATb" Then filepath = "\\WIN-GRM8M28FNLU\Tailor\DATA\StPicb" + "\" & nofatora & ".jpg" 'filepath = CurrentProject.Path & "\DATA\StPicb" + "\" & nofatora & ".jpg" ElseIf bb = "DATATAILORVATc" Then 'filepath = CurrentProject.Path & "\DATA\StPicc" + "\" & nofatora & ".jpg" filepath = "\\WIN-GRM8M28FNLU\Tailor\DATA\StPicc" + "\" & nofatora & ".jpg" ElseIf bb = "DATATAILORVATd" Then 'filepath = CurrentProject.Path & "\DATA\StPicd" + "\" & nofatora & ".jpg" filepath = "\\WIN-GRM8M28FNLU\Tailor\DATA\StPicd" + "\" & nofatora & ".jpg" End If Set imagefile = sdialog.ShowAcquireImage() imagefile.SaveFile filepath PicPath = filepath imagefile.Requery errorhandleexit: Exit Sub errorhandle: If Err.Number = "-2147024816" Then If MsgBox("توجد صورة تحمل نفس الرقم" & vbNewLine & "هل تريد حذف الصورة القديمة" & vbNewLine & "في حال الرفض لم تتم الاضافه", vbCritical + vbYesNo + vbMsgBoxRight, "تنبيه") = vbYes Then TempVars.add "name", InputBox(Space(30) & " ادخـل رقم عددتكرار الفاتورة ", Space(30) & DLookup(" [الاسم_التجاري] ", "بيانات_الشركه"), "1") 'Kill filepath If bb = "DATATAILORVATa" Then 'filepath = CurrentProject.Path & "\DATA\StPica" + "\" & nofatora & "(" & TempVars!name & ")" & ".jpg" filepath = "\\WIN-GRM8M28FNLU\Tailor\DATA\StPica" + "\" & nofatora & "(" & TempVars!name & ")" & ".jpg" ElseIf bb = "DATATAILORVATb" Then filepath = "\\WIN-GRM8M28FNLU\Tailor\DATA\StPicb" + "\" & nofatora & "(" & TempVars!name & ")" & ".jpg" 'filepath = CurrentProject.Path & "\DATA\StPicb" + "\" & nofatora & "(" & TempVars!name & ")" & ".jpg" ElseIf bb = "DATATAILORVATc" Then 'filepath = CurrentProject.Path & "\DATA\StPicc" + "\" & nofatora & "(" & TempVars!name & ")" & ".jpg" filepath = "\\WIN-GRM8M28FNLU\Tailor\DATA\StPicc" + "\" & nofatora & "(" & TempVars!name & ")" & ".jpg" ElseIf bb = "DATATAILORVATd" Then 'filepath = CurrentProject.Path & "\DATA\StPicd" + "\" & nofatora & "(" & TempVars!name & ")" & ".jpg" filepath = "\\WIN-GRM8M28FNLU\Tailor\DATA\StPicd" + "\" & nofatora & "(" & TempVars!name & ")" & ".jpg" End If Set imagefile = sdialog.ShowAcquireImage() imagefile.SaveFile filepath PicPath = filepath ' imagefile.Requery ' Else End If ElseIf Err.Number = "-2145320939" Then MsgBox "الاسكانر غير متصل", vbCritical + vbMsgBoxRight, "تنبيه" Else PicPath = Err.Number ' MsgBox Err.Description MsgBox " تم حـفـظ صـورة الفاتورة ( " & nofatora & " ) بنجاح" & " ", 48, DLookup(" [الاسم_التجاري] ", "بيانات_الشركه") & Space(5) End If Resume errorhandleexit  

اتفضل اخي هذا في الفورم الرئيسي اذا احتجته
If Forms![حركة فاتورة البيع 2]!Payment_Method = "cash" Then Me.Sales_Invoice_sub_Subform![اسعار الجملة بالدولار] = Me.Sales_Invoice_sub_Subform![cash price] End If If Forms![حركة فاتورة البيع 2]!Payment_Method = "credit" Then Me.Sales_Invoice_sub_Subform![اسعار الجملة بالدولار] = Me.Sales_Invoice_sub_Subform![two month] End If If Forms![حركة فاتورة البيع 2]!Payment_Method = "one month" Then Me.Sales_Invoice_sub_Subform![اسعار الجملة بالدولار] = Me.Sales_Invoice_sub_Subform![سعر الجمله $] وهذا في الفرعي
If Forms![حركة فاتورة البيع 2]!Payment_Method = "cash" Then Me.[اسعار الجملة بالدولار] = Me.[cash price] End If If Forms![حركة فاتورة البيع 2]!Payment_Method = "credit" Then Me.[اسعار الجملة بالدولار] = Me.[two month] End If If Forms![حركة فاتورة البيع 2]!Payment_Method = "one month" Then Me.[اسعار الجملة بالدولار] = Me.[سعر الجمله $] End If  

اتفضل
On Error GoTo Err_أمر24_Click If MsgBox(" هل انت متأكد ؟", _ vbCritical + vbYesNo, _ "تنبيه") = vbNo Then Exit Sub Else DoCmd.GoToRecord , , acNewRec Me.البرنامج.SetFocus End If Exit_أمر24_Click: Exit Sub Err_أمر24_Click: MsgBox Err.Description Resume Exit_أمر24_Click  

مافهمت
test951159 (1).mdb

اعمل شرط في الجدول
تحت الرصيد اكبر من صفر
<0

Between (IIf(Len([Forms]![tabf2]![start] & "")=0;Nz([numx];"0");[Forms]![tabf2]![start])) And (IIf(Len([Forms]![tabf2]![end] & "")=0;Nz([numx];"0");[Forms]![tabf2]![end]))  

كلامك صح
وهذا حسب طلب السائل
If Me.t1.Caption <> BFEBFBFF000406E3 Then MsgBox "يوجد خطاء", vbInformation, "تنبيه" DoCmd.Quit End If  
New Microsoft Access قاعدة بيانات (3) (1).accdb

كلامك صح
وهذا حسب طلب السائل
If Me.t1.Caption <> BFEBFBFF000406E3 Then MsgBox "يوجد خطاء", vbInformation, "تنبيه" DoCmd.Quit End If  
New Microsoft Access قاعدة بيانات (3) (1).accdb

اتغضل
DoCmd.OpenReport "report1", acPreview, , "[تاريخ الترقية الجديد]Between [Forms]![form1]![StartDate] And [Forms]![form1]![EndDate]"  

مشاركة مع عبد اللطيف سلوم
 
سلوم.rar

اتفضل Date()+[نص10]  
 
date.accdb

DoCmd.OpenReport "اسم التقرير", acViewPreview  

هل هذا ماتقصده
Function aboyaseen() DoCmd.OpenForm "FENABLE" End Function  
New Microsoft Access Database.accdb

اتفضل لعله طلبك
If Not IsNumeric(Mobile) Then MsgBox " فـضـلاً أدخـل أرقـام فـقـط ولـيـس حـر و ف ", vbInformation, " : خـطـاء " Cancel = True ElseIf Len(Mobile) <> 11 Then MsgBox " فـضـلاً أدخـل عـشـرة أرقـام فـقـط ولـيـس اقـل او اكـثـر ", vbExclamation, " : خـطـاء " Cancel = True 'هذاالسطر والا تحته يعيد التركيز لنفس الحقل' End If  
45.mdb

اظن هذا حسب طلبك
If Not IsNumeric(Tel) Then MsgBox " فـضـلاً أدخـل أرقـام فـقـط ولـيـس حـر و ف ", vbInformation, " : خـطـاء " Cancel = True 'هذاالسطر والا تحته يعيد التركيز لنفس الحقل' Me.Tel.Undo ElseIf Len(Tel) <> 11 Then MsgBox " فـضـلاً أدخـل احد عـشـر أرقـام فـقـط ولـيـس اقـل او اكـثـر ", vbExclamation, " : خـطـاء " Cancel = True 'هذاالسطر والا تحته يعيد التركيز لنفس الحقل' Me.Tel.Undo End If  
ex.mdb

الى الامام بارك الله فيك وزادك من علمه

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

جرب
DoCmd.SetWarnings False Dim x1 (x1 = Nz(DLookup("barcode", "tabl1", "[barcode] = " & Me.aa), 0) If x1 = 0 Then "MsgBox "This code is not registered", vbMsgBoxRight + vbCritical, "notes" DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdDeleteRecord else MsgBox " This is a registered code", vbMsgBoxRight + vbCritical, "notes" Exit Sub End If  

اخر سجل hrk_sh = Nz(DLast("Price", "HRR", "Nwaha='11'"), 0) اول سجل hrk_sh = Nz(First("Price", "HRR", "Nwaha='11'"), 0)  

بعد اذن اخي ابو عبدالله 
اتفضل هذا طلبك
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Alsnaf WHERE ID_Sanf ='" & Me.txt_2 & "'" & _ "or A2='" & Me.txt_2 & "'") If rs.RecordCount > 0 Then ID_Sanf = rs!ID_Sanf Sanf = rs!Sanf A2 = rs!A2 Else MsgBox "لايوجد رقم" 'Rajmsanf = "" Sanf.SetFocus txt_2.SetFocus ID_Sanf = Null Sanf = Null A2 = Null End If  

تسلم اخي جعفر
وهذا حسب طلب الاخ محمد صلاح
MP3_WAV_Player_SEMO_Pa3x(3).accdb

وهنا برقم التليفون
Dim rs As Recordset Set rs = CurrentDb.OpenRecordset("Clients", dbOpenDynaset) rs.FindFirst "Tel = '" & Me!Tel & "'" If Not rs.NoMatch Then rs.Bookmark = rs.Bookmark Me.Societé = rs!Societé Me.Adresse = rs!Adresse Me.Tel = rs!Tel Me.Email = rs!Email Me.nomClien = rs!nomClien Me.Ville = rs!Ville Else 'غير ذلك اي انه لم يجد سجل MsgBox " يـرجـاء الـتـأكـد .... لا يـو جـد زبون بـهـذا الرقم : " & Me.Tel, , " : خـطـاء " End If  

اذا كان رقم الفاتورة بالنموذج الرئيسي بيكون هكذا If MsgBox(" هــل تـريـد حفظ الفاتورة رقـم " & vbCrLf & " ( " & me.[idNo] & " ) ", vbYesNo, " تنبية ") = vbYes Then واذا كان بالفرعي بيكون هكذا If MsgBox(" هــل تـريـد حفظ الفاتورة رقـم " & vbCrLf & " ( " & [forms]![sell]![subform].[form]![idNo] & " ) ", vbYesNo, " تنبية ") = vbYes Then  

شوف هذا لعله يفي بالغرض
تحل الاسم او جزء منه ودخل السنه او جزء منها
 
Ex9-29.accdb

انا مشيت على ملفك الاول كان الشرط الاسم مثل اسم الجدول الاخر
اتفضل التعديل
DoCmd.SetWarnings False DoCmd.RunSQL "UPDATE ntak SET ntak.knaw = ntak.knaw+[Forms]![نموذج1]![end]" & vbCrLf & _ "WHERE (((ntak.esm)=[Forms]![نموذج1]![نص611]));" DoCmd.SetWarnings True  
Microsoft_Access_قاعدة_بيانات_جديد (1).accdb