jjafferr

الآن فهمت الذي تريد عمله!! اذا كان الملف موجود في المجلد الهدف ، اذن افتحه ، واذا ما موجود في المجلد الهدف ، ولكنه موجود في المجلد المصدر ، اذن اعمل نسخه منه الى المجلد الهدف ن ثم افتحه من هناك ، واذا لم يتواجد في المجلدين ، اعطي رسالة الانذار بعدم وجود الشهادة: Private Sub cmd_Open_the_File_from_Destination_Click() Dim strFilePath As String Source = DLookup("[attachemnts bath]", "bath", "[ID] = 1") Destination = DLookup("[attachemnts bath]", "bath", "[ID] = 2") strFilePath = Destination & "\" & Me.ID & ".PDF" If Dir(strFilePath) <> "" Then Application.FollowHyperlink strFilePath ElseIf Dir(Source & "\" & Me.ID & ".PDF") <> "" Then FileCopy Source & "\" & Me.ID & ".PDF", Destination & "\" & Me.ID & ".PDF" 'give the slow PCs wait time until copying is completed PauseTime = 2 ' Set duration. Start = Timer ' Set start time. Do While Timer < Start + PauseTime DoEvents ' Yield to other processes. Loop Application.FollowHyperlink strFilePath Else MsgBox "There are no GAS Certificates saved for this Property. Please Add or Scan a new document!" End If End Sub 584.2.Copy PDF from A folder To B Folder.accdb.zip

جرب هذا الـ TreeView (نفس الملف من الرابط) ، وقد عملت عليه بعض التعديلات: 1. الزر اليمين لا يعمل ، 2. يفتح النموذج مباشرة على \:D جعفر SampTree_StartFolder.zip

اذا حذفت الملف من الاصل ، فسيعطيك البرنامج رسالة بعدم وجود الشهادة ، ولكن ولكي اثبت لك: احذف هذا السطر FileCopy Source & "\" & Me.ID & ".PDF", Destination & "\" & Me.ID & ".PDF" واستبدله بهذا السطر Name Source & "\" & Me.ID & ".PDF" As Destination & "\" & Me.ID & ".PDF" هنا الكود لا يقوم بنسخ الملف من المصدر ، وانما بنقله من المصدر ، وسوف يقوم بفتحه ، ثم انظر في مجلد المصدر ، فلن تراه هناك ، بل ستراه في مجلد الهدف جعفر

تفضل الكود لهذه العملية هو Private Sub cmd_Open_All_Click() Dim rst As DAO.Recordset Set rst = Me.RecordsetClone rst.MoveLast: rst.MoveFirst RC = rst.RecordCount For i = 1 To RC Application.FollowHyperlink rst!Site rst.MoveNext Next i rst.Close: Set rst = Nothing End Sub جعفر 579.1.test90.mdb.zip

وعليكم السلام لا ارى كيف ذلك ، فالكود يأخذ مسار المجلد الذي تم النسخ اليه: Private Sub cmd_Open_the_File_from_Destination_Click() ... strFilePath = Destination & "\" & Me.ID & ".PDF" ... Application.FollowHyperlink strFilePath ... End Sub هل اخذت الكود والصقته ببرنامجك (يعني غير البرنامج الذي ارفقته انا) ؟ اذا فعلت ، فيجب عليك ان تضيف حقل ID للجدول bath ، بحيث: ID = 1 لسجل الـ Source ID = 2 لسجل الـ Destination جعفر

السلام عليكم أختي ، الظاهر ان الكود فيه مشكلة ، وتم اكتشافها وتعديلها هنا: جعفر

كان في خطأ في الكود ، والحمدلله استطعت معرفته وتغييره حاليا الكود يعطيك فقط اذا في ايام متتالية اكثر من 8 ايام مثلا (انت تحدد هذا اليوم ، وحتى ممكن نضعه في النموذج الذي به التواريخ من-الى). الكود اصبح: Option Compare Database Function Check_Abs(EN) On Error GoTo err_Check_Abs If EN = 0 Then aaaa = 1 End If 'EN = Employee Name WAS 'EN = Employee Code NOW Dim rst As DAO.Recordset fD = [Forms]![frm_get_attendance_data]![Date_From] eD = [Forms]![frm_get_attendance_data]![Date_To] 'myCriteria = "[Emp_Name]='" & EN & "'" myCriteria = "[Emp_Code]=" & EN myCriteria = myCriteria & " And [Leave_Type]='غياب'" myCriteria = myCriteria & " And [day_date] Between " & DateFormat(fD) & " And " & DateFormat(eD) 'Set rst = CurrentDb.OpenRecordset("Select * From tbl_Attendance_in Where [Emp_Name]='" & EN & "' And [Leave_Type]='غياب' And [day_date] Between '" & DateFormat(fD) & "' And '" & DateFormat(eD) & "'") Set rst = CurrentDb.OpenRecordset("Select * From tbl_Attendance_in Where " & myCriteria & " Order by [day_date]") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount Seq = 1 Prev_Date = rst![day_date] For i = 1 To RC If rst![day_date] = DateAdd("d", 1, Prev_Date) Then Seq = Seq + 1 'do we have a Next Day 'Next Day iNext_Day = DateAdd("d", 1, rst![day_date]) 'Move to Next Records 'and compare days rst.MoveNext If rst![day_date] <> iNext_Day And Seq >= 8 Then Check_Abs = Correct_Names(Seq) Exit For End If rst.MovePrevious Else Seq = 1 End If Prev_Date = rst![day_date] Next_ii: rst.MoveNext Next i ' If Seq >= 8 Then ' Check_Abs = Seq & " ايام متتالية" ' Else ' Check_Abs = RC & " ايام غير متتالية" ' End If Exit_Check_Abs: rst.Close: Set rst = Nothing Exit Function err_Check_Abs: If Err.Number = 3021 Then If Seq >= 8 Then Check_Abs = Correct_Names(Seq) Else Check_Abs = "" End If Resume Exit_Check_Abs Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function Function Correct_Names(N) Select Case N Case 2 Correct_Names = " يومان متتاليان" Case 3 To 10 Correct_Names = N & " ايام متتالية" Case Else Correct_Names = N & " يوم متتالي" End Select End Function جعفر 588.حصر الغياب.mdb.zip

1. اعمل استعلام ، وادخل فيه اي حقلين من اي جدول ، احدهما فيه بيانات ، والاخر مافيه بيانات ، اذا استعمل '*' Like في الحقل الذي ليس فيه بيانات ، سترى انه لا تحصل على سجلات اصلا ، مع ان الحقل الآخر فيه بيانات ، هذه كانت مشكلتك ، لأنه لما تستعمل المعيار Peinture ، سترى ان الحقل Heure مثلا ليس به بيانات ، واذا استعملت المعيار '*' Like عليه ، فلن تحصل على اي نتيجة. لذا ، كان لازم نتخلص من معايير '*' Like للحقول التي لا توجد بها معايير ، لذا فقمت بحذفها ، وهذا لا يؤثر على نتائج الاستعلام. 2. ونتيجة الى حذف '*' Like للحقول التي ليست بها معايير ، اصبح لدينا الكثير من " & "And" & " الزائدة ، والتي تمنع من عمل SQL الاستعلام ، فاضطررت الى حذفها ، 3. بقية And الاولى ، والتي كان يجب حذفها كذلك ، فاسهل سطر لحذفها كان هذا جعفر

نعم ، كانت هناك مشكلة عندما الحقل يكون فارغ ، والمعيار '*' Like ، فلا تحصل على نتائج تم تغيير الكود الى: Function SearchCriteria() Dim strProject As String Dim strProfil, strMachine, strRepere, strDone, strTime, strUnits As String Dim strFirstDate, strLastDate As Date Dim Task As String Dim strCriteria As String '.................................................................................. If IsNull(Me.cboTime) Then Else strTime = " And [Heure] = '" & Me.cboTime & "' " End If '................................................................................. If IsNull(Me.cboProject) Then Else strProject = " And [N° BS] = '" & Me.cboProject & "' " End If '................................................................................. If IsNull(Me.cboMachine) Then Else strMachine = " And [Machine] = '" & Me.cboMachine & "' " End If '................................................................................. If IsNull(Me.cboProfil) Then Else strProfil = " And [Désignation] = '" & Me.cboProfil & "' " End If '................................................................................ If IsNull(Me.cboRepere) Then Else strRepere = " And [Repères] = '" & Me.cboRepere & "' " End If '................................................................................ If IsNull(Me.cboDone) Then Else strDone = " And [Done] = '" & Me.cboDone & "' " End If '................................................................................ If IsNull(Me.txtFirstDate) Or IsNull(Me.txtLastDate) Then Else strFirstDate = " And [LaDate]>= #" & Format(txtFirstDate, "mm/dd/yyyy") & "#" _ & " And [LaDate] <= #" & Format(txtLastDate, "mm/dd/yyyy") & "#" End If '................................................................................ If IsNull(Me.cboUnits) Then Else strUnits = " And [Units from] = '" & Me.cboUnits & "' " End If '................................................................................ strCriteria = strProject & strMachine & strProfil & strRepere & strDone & strFirstDate & strTime & strUnits Task = "select * from tblRealisation where " & strCriteria 'Debug.Print Replace(Task, "where And", "where") Me.RealisationSubForm.Form.RecordSource = Replace(Task, "where And", "where") Me.RealisationSubForm.Form.Requery End Function جعفر

البرنامج يرى التواريخ بين التاريخين ، ثم يحسب الايام المتتالية (3 ايام في الرابط) ، ولا يهمه مكان الايام المتتاليه !! واذا وجد ايام متتالية حسب الطلب ، لا يحسب الايام المتتاليه الاخرى. رجاء المحاولة مرة اخرى جعفر

هل شفت الرابط اللي ارفقته لك؟

وعليكم السلام انزلت المرفق ، وكل شئ شغال تمام يعني لأول مرة نشوف سؤال ما بحاجة الى إجابة جعفر

وعليكم السلام ههلا وسهلا بك في المنتدى ، رجاء قراءة قوانين المنتدى قبل وضع مشاركة والمنتدى لتبادل المعرفة ، فرجاء وضع ما لديك ، ثم طلب طلب المساعدة في طريقة عمل الاضافات عليه. قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف مخالف - يُغلق جعفر

شكرا جزيلا اخي شفان على المداخله والتوضيح اختي maya8 وكذلك المرفق غير موجود ، فالرابط الذي وضعتيه في مشاركتك لا يعمل لكي تضعي مرفقك في المشاركة ، فيجب عليكي 1. ضغط ملف الاكسس بصيغة rar او zip ، 2. واما الصور بصيغة jpg او gif او bmp او png فلا تحتاج الى ضغط ، 3. تستطيعين ارفاق مجموعة من الملفات والصور ، بحيث لا يتجاوز مجموع حجمها (الحد الاقصى) ، 4. طريقة ارفاق المرفقات ، وكما هو موضح في اسفل المشاركة (اسحب الملفات الي هنا لارفقاها ، او اختر ملف...) سحب المرفقات الى المنطقة المظلله اسفل المشاركة ، النقر على كلمة "اختر ملف..." (المنطقة المظلله اسفل المشاركة). جعفر

وعليكم السلام تفضل: Private Sub cmd_Open_the_File_from_Destination_Click() Dim strFilePath As String Source = DLookup("[attachemnts bath]", "bath", "[ID] = 1") Destination = DLookup("[attachemnts bath]", "bath", "[ID] = 2") strFilePath = Destination & "\" & Me.ID & ".PDF" If Dir(Source & "\" & Me.ID & ".PDF") <> "" Then FileCopy Source & "\" & Me.ID & ".PDF", Destination & "\" & Me.ID & ".PDF" 'give the slow PCs wait time until copying is completed PauseTime = 2 ' Set duration. Start = Timer ' Set start time. Do While Timer < Start + PauseTime DoEvents ' Yield to other processes. Loop Application.FollowHyperlink strFilePath Else MsgBox "There are no GAS Certificates saved for this Property. Please Add or Scan a new document!" End If End Sub Private Sub Form_Load() Dim strFilePath As String Destination = DLookup("[attachemnts bath]", "bath", "[ID] = 2") strFilePath = Destination & "\" & Me.ID & ".PDF" If Dir(strFilePath) <> "" Then 'الملف موجود، غير لون خلفية الزر الى اخضر Me.cmd_Open_the_File_from_Destination.BackColor = RGB(0, 255, 0) 'Green Else 'الملف غير موجود Me.cmd_Open_the_File_from_Destination.BackColor = RGB(255, 0, 0) 'Red End If End Sub جعفر 584.1.Copy PDF from A folder To B Folder.accdb.zip

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

وعليكم السلام تفضل هذا الرابط جعفر

اخاف تعتقد اني عبقري اخبرك كيف عرفت الجواب استخدم هذا الكود: resalh = MsgBox("subject", 1 + r_msg, "titel") msgbox "Checking= " & resalh ثم اضغط على نعم وشوف قيمة resalh ، واضغط على لا وشوف قيمة resalh جعفر

كيف زر واحد؟ شو الاوامر اللي تريدها تصير ، بالتسلسل؟

تفضل Option Compare Database Private Sub cmd_Copy_From_Source_to_Destination_Click() Source = DLookup("[attachemnts bath]", "bath", "[ID] = 1") Destination = DLookup("[attachemnts bath]", "bath", "[ID] = 2") FileCopy Source & "\" & Me.ID & ".PDF", Destination & "\" & Me.ID & ".PDF" End Sub Private Sub cmd_Open_the_File_from_Destination_Click() Dim strFilePath As String Destination = DLookup("[attachemnts bath]", "bath", "[ID] = 2") strFilePath = Destination & "\" & Me.ID & ".PDF" If Dir(strFilePath) <> "" Then Application.FollowHyperlink strFilePath Else MsgBox "There are no GAS Certificates saved for this Property. Please Add or Scan a new document!" End If End Sub Private Sub Form_Load() Dim strFilePath As String Destination = DLookup("[attachemnts bath]", "bath", "[ID] = 2") strFilePath = Destination & "\" & Me.ID & ".PDF" If Dir(strFilePath) <> "" Then 'الملف موجود، غير لون خلفية الزر الى اخضر Me.cmd_Open_the_File_from_Destination.BackColor = RGB(0, 255, 0) 'Green Else 'الملف غير موجود Me.cmd_Open_the_File_from_Destination.BackColor = RGB(255, 0, 0) 'Red End If End Sub جعفر Copy PDF from A folder To B Folder.zip

ايوه ، كده ويلا بلاش جعفر

وعليكم السلام تفضل يا زعيم MessageBoxH Me.hwnd resalh = MsgBox("subject", 1 + r_msg, "titel") If resalh = 1 Then MsgBox "Yes was selected" Else MsgBox "No was selected" End If جعفر

في نسخة الاكسس الانجليزية (التي استعملها انا) ، نستخدم الفاصلة ، بينما في النسخة العربية يجب استخدام الفاصلة المنقطة (;) ، فتصبح المعادلة: Expr1: Format([number1];"00") & " " & Format([number2];"00") جعفر

انت في الاستعلام عندك الحقل: Expr1: [number1] & " " & [number2] فاستبدله بالحقل Expr1: Format([number1],"00") & " " & Format([number2],"00") وصلى الله وبارك انا اتعمد احيانا ان لا اضع المرفق ، حتى يكون فهم الموضع اعمق جعفر

اعتذر منك أخي وائل فالبرنامج وكما اوضحت في الشرح هو: وهذا للمواقع التي تتطلب ادخال بيانات ، ثم استرجاع رقم الموافقة (او شئ من هذا القبيل) ، جعفر