Shivan Rekany

اتفضل اخي
في محرر الاكواد وبعد تحديث حقل التوجيه الصق هذا الكود
Me.رقم_الفاتوره = Nz(DMax("[رقم الفاتوره]", "مجمع الفواتير اجمالى", "[التوجيه]='" & [التوجيه] & "'"), 0) + 1  

اتفضل اليك ما طلبت
لكن ارجوا ان لا نتعدى قوانين  المنتدى .. لكل موضوع سؤال جديد بعد البحث عن ما يريد
هذا هو الكود لحذف الصور مع السجل
Private Sub Command21_Click() On Error Resume Next Dim MyPict As String DoCmd.SetWarnings False MyPict = CurrentProject.Path & Me.PicFile Kill (MyPict) DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdDeleteRecord Me.Requery DoCmd.SetWarnings True MsgBox "تم الحذف" End Sub وهذه لحذف جميع الملفات من فولدر و حذف جميع السجلات
Private Sub Command22_Click() On Error Resume Next Dim MyPict As String DoCmd.SetWarnings False MyPict = (CurrentProject.Path & "\" & "fileStores\*.*") Kill (MyPict) DoCmd.RunCommand acCmdSelectAllRecords DoCmd.RunCommand acCmdDeleteRecord Me.Requery DoCmd.SetWarnings True MsgBox "تم الحذف" End Sub ولطلبك هذا
فقط تم حذف هذا
CurrentProject.Path + من هذا
Me.PicFile = CurrentProject.Path + "\fileStores\" & ("" & mynam & "") اي يبقى هذا
Me.PicFile = "\fileStores\" & ("" & mynam & "") واليك الملف بعد تعديل والاضافة
ولا تنسى اختار افضل جواب لكي من يفتح هذا الموضوع يعرف ويستفيد اكثر
تقبل تحياتي
 
pic.rar

اولا يجب ان يكون مصدر الكومبوبوكس بيكون ليست بوكس
ثانيا يجب ان يكون خصائصه هكذا

 

اتفضل
القي نظرتا الى استعلام لو اين و لوك اوت
 
login.rar

استخدم هذا 
Private Sub WorkScope_AfterUpdate() Dim rst As DAO.Recordset Dim D 'As Integer Dim X As Integer ' = Cycles Dim E ' = CSN Dim F ' = CSO Dim Z ' = VisitSeq Set rst = CurrentDb.OpenRecordset("Select * From qry_workscope_utility") rst.MoveLast: rst.MoveFirst X = rst!Cycles rst.MoveNext D = rst!VisitNo E = rst!CSN F = rst!CSO Z = rst!VisitSeq rst.MovePrevious If D = "NA" Then Else If IsNull(Form_frm_WORKSCOPE.VisitNo) Then rst.Edit rst!VisitNo = D + 1 rst.Update rst.Close: Set rst = Nothing Else End If End If If E = "NA" Then Else If IsNull(Form_frm_WORKSCOPE.CSN) Then rst.Edit rst!CSN = E + X rst.Update rst.Close: Set rst = Nothing End If End If If IsNull(Form_frm_WORKSCOPE.Visit_Seq) Or Form_frm_WORKSCOPE.Visit_Seq = "" Then rst.Edit rst!CSO = "" rst.Update rst.Close: Set rst = Nothing End If If Z = "0" Then rst.Edit rst!CSO = X rst.Update rst.Close: Set rst = Nothing End If If Z >= "1" Then rst.Edit rst!CSO = X + F rst.Update rst.Close: Set rst = Nothing End If Me.frm_WORKSCOPE.Requery End Sub اليك مرفقك
 
qs-4.rar

اتفضل استاذ
اليك هذا الاستعلام
SELECT tbData.ID, tbData.SALAIRE, DSum("[Janvier]","tbMois","[Data_id]=" & [ID])+DSum("[Février]","tbMois","[Data_id]=" & [ID])+DSum("[mars]","tbMois","[Data_id]=" & [ID])+DSum("[avril]","tbMois","[Data_id]=" & [ID])+DSum("[mai]","tbMois","[Data_id]=" & [ID])+DSum("[Juin]","tbMois","[Data_id]=" & [ID])+DSum("[Juillet]","tbMois","[Data_id]=" & [ID])+DSum("[Août]","tbMois","[Data_id]=" & [ID])+DSum("[Septembre]","tbMois","[Data_id]=" & [ID])+DSum("[Octobre]","tbMois","[Data_id]=" & [ID])+DSum("[Novembre]","tbMois","[Data_id]=" & [ID])+DSum("[Décembre]","tbMois","[Data_id]=" & [ID]) AS Total_Jour, ([SALAIRE]/30)*[Total_Jour] AS Debiteur, DSum("[Montant]","tbDch","[Data_id]=" & [ID]) AS Creancier, [Creancier]-[Debiteur] AS [Rest Apye] FROM (tbData INNER JOIN tbDch ON tbData.ID = tbDch.Data_id) INNER JOIN tbMois ON tbData.ID = tbMois.Data_id GROUP BY tbData.ID, tbData.SALAIRE; ملفك بعد اضافة الاستعلام
 
Database.rar

اتفضل 
 
=IIf([نص582]>[نص580];"+" & ([نص580]/[نص582]);IIf([نص582]<[نص580];"-" & ([نص580]/[نص582]);([نص580]/[نص582]))) لكن هناك اريد اسألك
هل تريد ان تعرف نسبة الفرق بين الرقمين بالنسبة المؤية او نسبة المؤوية بين الرقمين ؟
لان الجوابي هو لنسبة المؤيو بين الرقمين وليس نسبة الفرق بين الرقمين بالنسبة المؤوية
 
 
نسبة الفرق بين رقمين متغيرين.rar

اتفضل
غيرت حقل اي دي من نوع ترقيم تلقائي الى الرقم
وبعدين في نموذج الفرعي في حدث بعد تحديث لحقل سنة كتبت هذا الكود
Private Sub elyear_AfterUpdate() Me.id = Nz(DMax("[id]", "raseed", "[nationalty]=" & [Forms]![person]![nationalty]), 0) + 1 End Sub واليك مرفقك بعد تعديل 
اكتب رقم قومي جديد و اكتب السنة في نموذج فرعي راح تجد التغيير بعد تحديث 
 
الاجازات - Copy_2.rar

الیک هذا
 
test122.rar

اعمل ديفيلوت فاليو لحقل التاريخ = DATE()
بلى يحتسب .. لكن يحتسب فقط السجلات اللي تاريخهم هو تاريخ اليوم
المرفق اللي في مشاركتي السابقة مضبوطة وبيشتغل تمام

اتفضل اليك هذا 
Dim sql As String 'sql = "UPDATE [C:\Users\MyShiv\Desktop\تحيث جدول في قاعدة خارجية\db1.mdb].Table1 INNER JOIN [C:\Users\MyShiv\Desktop\تحيث جدول في قاعدة خارجية\db2.mdb].Table2 ON Table1.ID = Table2.ID SET Table2.nAME = [Forms]![Form1]![nAME], Table2.no_phone = [Forms]![Form1]![no_phone] WHERE (((Table2.ID)=[Forms]![Form1]![ID]));" 'sql = "UPDATE Table1 INNER JOIN [C:\Users\MyShiv\Desktop\تحيث جدول في قاعدة خارجية\db2.mdb].Table2 ON Table1.ID = Table2.ID SET Table2.nAME = [Forms]![Form1]![nAME], Table2.no_phone = [Forms]![Form1]![no_phone] WHERE (((Table2.ID)=[Forms]![Form1]![ID]));" sql = "UPDATE Table1 INNER JOIN [db2].Table2 ON Table1.ID = Table2.ID SET Table2.nAME = [Forms]![Form1]![nAME], Table2.no_phone = [Forms]![Form1]![no_phone] WHERE (((Table2.ID)=[Forms]![Form1]![ID]));" DoCmd.SetWarnings False DoCmd.RunSQL (sql) DoCmd.SetWarnings True MsgBox "تم تحديث" واليك قاعدة بيانات بعد تعديل
اولا اختر قاعدة بيانات باسم db2
بعدين اضغطعلى زر للتحديث
 
تحيث جدول في قاعدة خارجية - Copy.rar

660.Test2000.rar

حسب فهمي لسؤالك اليك هذه الملاحظة
 عند كتابة DATE في محرر الفيجوال مثلا
Me.start = date اذن انت بتقول مربع نصي اي حقل باسم ستارت يساوي تاريخ اليوم

 

اليك هذا
 
test1000.rar

اليك هذا
Private Sub تدقيق4_Click() If Time() >= #12:00:01 AM# And Time() <= #4:00:00 AM# Then Me.test1 = Date - 1 Else Me.test1 = Date End Sub  
test1001.rar

اتفضل اليك هذا
Private Sub Form_Current() If Len(Forms!frm_mowadef!subfrm!Daira & "") = 0 Then Forms!frm_mowadef!subfrm!Daira.Visible = False Else Forms!frm_mowadef!subfrm!Daira.Visible = True End Sub والمرفق بعد تعديل
 
db2 (2).rar

اسف نسيت ان ادرج في الكود جدول اي دي
لكن يتغير في جدول الاخر
اتفضل اليك هذا سيتغير في كل الجداول
Private Sub serial_AfterUpdate() On Error Resume Next Dim TeadilMyName As String TeadilMyName = "UPDATE ID INNER JOIN SUB ON ID.id1 = SUB.id SET ID.serial = [Forms]![DataMasterForm]![serial], SUB.serial = [Forms]![DataMasterForm]![serial] WHERE (((ID.id1)=[Forms]![DataMasterForm]![id]));" DoCmd.SetWarnings False DoCmd.RunSQL (TeadilMyName) DoCmd.SetWarnings True DoCmd.RunCommand acCmdSaveRecord End Sub اليك مرفق
 
test444.rar

DoCmd.OutputTo acOutputReport, "rptRateCard", acFormatPDF, ("RateCard" & Format(Now(), "mmmyyyy") & ".pdf"), True  

اتفضل
اضفت حقل رقم في مربع تحرير وسرد
وغيرت هذا السطر من البحث
rs.FindFirst "[رقم الملف] = " & Me![مربع_تحرير_وسرد96].Column(1) في حدث بعد تحديث و عند الحالي ايضا
اليك ملف بعد تعديل
 
test5.rar

اليك هذا الحل لعل يفيدك
اولا عملت استعلام للاسماء اللي في جدول الموظفين وليس موجودين في جدول الرواتب
وهذا هو الاستعلام
SELECT persons.* FROM persons LEFT JOIN Salary ON persons.[EmpNumber] = Salary.[EmpNumber] WHERE (((Salary.EmpNumber) Is Null)); وعملت نموذج عليه
واستخدمت هذا الكود لزر 
Private Sub Command0_Click() Dim MyCount As Integer MyCount = DCount("*", "personsWithoutMatchingSalary") If MsgBox("هناك ( " & MyCount & " ) اسماء لم يكن في جدول الرواتب .. هل تريد ان تنظر الى اسماءهم ", vbYesNo, "تنبيه") = vbYes Then DoCmd.OpenForm "personsWithoutMatchingSalary", acNormal End If End Sub اليكي المرفق
 
bmn.rar

اتفضل
كود عربي المتقدم سيكون كالتالي في الاستعلام
متقدم عربي: DCount("[Sit_no]";"sheet";"[group]='" & [Group] & "'" & "and n_ar1= 'عربي'") غائب عربي
غائب عربي: DCount("Sit_no";"sheet";"[group]='" & [group] & "'" & "and ar3 = 'غ'") متقدم رياضيات
متقدم رياضيات: DCount("Sit_no";"sheet";"[group]='" & [group] & "'" & "and n_ma1= 'رياضيات'") غائب رياضيات
غائب رياضيات: DCount("Sit_no";"sheet";"group='" & [group] & "'" & "and ma3 = 'غ'") اي يعني الاستعلام كله سيكون كالتالي
SELECT sheet.Group, DCount("[Sit_no]","sheet","[group]='" & [Group] & "'" & "and n_ar1= 'عربي'") AS [متقدم عربي], DCount("Sit_no","sheet","[group]='" & [group] & "'" & "and ar3 = 'غ'") AS [غائب عربي], DCount("Sit_no","sheet","[group]='" & [group] & "'" & "and n_ma1= 'رياضيات'") AS [متقدم رياضيات], DCount("Sit_no","sheet","group='" & [group] & "'" & "and ma3 = 'غ'") AS [غائب رياضيات] FROM sheet GROUP BY sheet.Group; القي نظرتا الى النتيجة في الصورة

واليك المرفق بعد تعديل
احصاء متقدم وغائب.rar

استأذن من استاذنا @محمدنجار 
اتفضل
غيرت خاصية زر الحاسبة Enabled = no
واستخدمت هذا الكود لزر تشغيل الحاسبة
Private Sub أمر17_Click() X = InputBox("ادخل كلمة السر الصحيحة", "تنبيه") If X = 1 Then Cancel = MsgBox("كلمة السر صحيحة", vbOKOnly + vbMsgBoxRight, "تنبيه") Me.Command26.Enabled = True Else: MsgBox "كلمة السر غير صحيحة", vbOKOnly + vbMsgBoxRight, "تنبيه" Me.Command26.Enabled = False End If End Sub اتفضل مع القاعدة
 
test 3_UP.rar

ما هو السبب عمل 302000 تقرير في القاعدة ؟ 
ما قصدك بهذا ؟
اتفضل رأيت احد مشاركات استاذنا @ابوخليل وكان فيها الحل
وكان استخدمت هذه الوحدة نمطية
Option Compare Database Global Const SW_HIDE = 0 Global Const SW_SHOWNORMAL = 1 Global Const SW_SHOWMINIMIZED = 2 Global Const SW_SHOWMAXIMIZED = 3 Private Declare Function apiShowWindow Lib "user32" _ Alias "ShowWindow" (ByVal hwnd As Long, _ ByVal nCmdShow As Long) As Long Function fSetAccessWindow(nCmdShow As Long) Dim loX As Long Dim loForm As Form Dim loReport As Report On Error Resume Next Set loForm = Screen.ActiveForm Set loReport = Screen.ActiveReport If Err <> 0 Then loX = apiShowWindow(hWndAccessApp, nCmdShow) Err.Clear End If If nCmdShow = SW_SHOWMINIMIZED And loForm.Modal = True Or _ nCmdShow = SW_SHOWMINIMIZED And loReport.Modal = True _ Then ' MsgBox "Cannot minimize Access with " _ ' & (loForm.Caption + " ") _ ' & "form on screen" ElseIf nCmdShow = SW_HIDE And loForm.PopUp <> True Or _ nCmdShow = SW_HIDE And loForm.loReport <> True _ Then ' MsgBox "Cannot hide Access with " _ ' & (loForm.Caption + " ") _ ' & "form on screen" Else loX = apiShowWindow(hWndAccessApp, nCmdShow) End If fSetAccessWindow = (loX <> 0) End Function وفي حدث فتح التقرير
كان كتبت 
Private Sub Report_Open(Cancel As Integer) DoCmd.Minimize DoCmd.OpenReport Me.Name, acViewPreview End Sub وفي زر فتح التقرير
كتبت كود فتح التقرير بشكل عادي
Private Sub Command1_Click() DoCmd.OpenReport "report1", acViewPreview End Sub والنتيجة 100%
واليك المرفق
و نشكر استاذنا ابوخليل على هذا
hide (1).rar

اتفضل
فقط غير في اسماء النماذج في الكود
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = 49 Then DoCmd.OpenForm "جدول البيع", acNormal ElseIf KeyCode = 50 Then DoCmd.OpenForm "ركود", acNormal ElseIf KeyCode = 51 Then DoCmd.OpenReport "جدول الزبائن", acViewPreview End If End Sub Private Sub Form_Open(Cancel As Integer) Me.KeyPreview = True End Sub  
مبيعات نسخة 2003 (2) (1).zip