jjafferr

وعليكم السلام أخي طارق انا عندي حالة طارئه من كم يوم ولازالت ، ولم ادخل المنتدى. انا شخصيا لا اتعامل مع الافراد حسب هواي (ولم ألاحظ هذا على اي من المشاركين) ، ولكننا جميعا نساعد قدر استطاعتنا ووقتنا المتاح. سأحاول الليلة عمل المستطاع لإيجاد الحل لطلبك جعفر

تفضل يا سيدي الكريم شاكرا لك جميل كلمات ، ودعائك جعفر 230.Report_to_Excel.mdb.zip

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

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

السلام عليكم أخي موسى الرابط التالي فيه طريقة حفظ النسخ الاحتياطية: http://www.officena.net/ib/topic/63797-دعوة-لتطوير-اداه-لنسخ-قاعدة-البيانات-المرتبطة-كل-مدة-زمنية-ساعةيومشهرسنة/ جعفر

أخي نكرو مانسر ما سمعنا منك ، هل الرابط والامثلة اللي انا وضعتها تخدم طلبك؟ جعفر

السلام عليكم . 1. والكود لا يفعل هذا الشئ ، مثل طلبك ، فالكود لا يعمل على ازرار + و - ، 2. وهذا الذي يفعله البرنامج بالضبط ، مثل طلبك ، فالكود يعمل على ازرار الاصناف فقط. وين الخطأ اذا؟ جعفر

وعليكم السلام . تذكر لما سألتك: . ولا يهمك تريد شئ ثاني قبل ما اقفل الدكان جعفر

. وعليكم السلام اخي رمهان 1. الـ Recordset يكون باستخدام ADO او DAO ، فلذلك الامثلة حسب طلب السؤال 2. انا افتكرت الموضوع مثلك ، ولكن لما الاخ نكرو مانسر شرح الموضوع بشكل اكبر ، فارفقت له رابط بنفس الفكرة (طبعا حسب فهمي للموضوع) جعفر

وعليكم السلام أختي انا عملت لك 3 استعلامات ، على اساس الحوارات اللي دارت بينك وبين الاستاذ رمهان رجاء تتأكدي من النتائج جعفر 236.‫tajera3.mdb.zip

امبونك متدوده وخابصها من الزين لما دخلت التاريخ تو الكود كذاك: Private Sub PageHeaderSection_Format(Cancel As Integer, FormatCount As Integer) 'a = DLookup("[Org_Name]", "tbl_Org", "[Org_ID]='" & Forms!frm_Org_Details!Org_ID & "'") a = Forms!frm_Org_Details!cmb_Org_Name.Column(0) Me.Body_Text.Caption = Replace(Me.Body_Text.Caption, "a1", a) Me.Body_Text.Caption = Replace(Me.Body_Text.Caption, "a2", Forms!frm_Org_Details!cmb_Org_ID) 'Me.Body_Text.Caption = Replace(Me.Body_Text.Caption, "dh") 'Me.Body_Text.Caption = Replace(Me.Body_Text.Caption, "dm") Calendar = vbCalHijri dh = Date dh = Format(dh, "yyyy/mm/dd") Calendar = vbCalGreg dm = Date dm = Format(dm, "dd-mm-yyyy") End Sub . والمرفق في خدمتك جعفر 224.1.تعديل1 .اصدار التراخيص.mdb.zip

2. لانه انا شايف الدالة ConnectSQL() بتنادي نفسها اذا الكنكشن مغلق ! وخلق الكائن وفتحه ياتي بعد مناداة الدالة ! فهنا هل سيتم تنفيذ باقي جسم الدالة خصوصا انها تتطلب تمرير الكائن cnn وهو لسا لم تسند له القيم !! 1. والله أخوي رمهان البرنامج ليس بالكامل ، ومشتت ، وصار لي 7 سنوات ما لمسته ، فما اتذكر ايش وضعه 2. انا فتحت الاتصال من كود النموذج الاساسي بمناداة الدالة Call ConnectSQL(cnn) جعفر

وعليكم السلام أخي كرار هاي ما كانت سهلة لازم تستخدم الزر اللي في النموذج ، والكود حقه: Private Sub cmd_Combine_Click() 'delete the old data mySQL = "Delete * From tbl_PP" CurrentDb.Execute (mySQL) Dim rstpp As DAO.Recordset Dim rst As DAO.Recordset Set rstpp = CurrentDb.OpenRecordset("Select * From tbl_PP") '1 Set rst = CurrentDb.OpenRecordset("Select * From sh Order By tash") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount 'add all the records For i = 1 To RC rstpp.AddNew rstpp!iDate = rst!tash rstpp!Purchase = rst!mbsh rstpp.Update rst.MoveNext Next i '2 Set rst = CurrentDb.OpenRecordset("Select * From ts Order By tats") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount 'we should check if the date is available, then we should use it For i = 1 To RC rstpp.FindFirst "iDate=#" & rst!tats & "#" If rstpp.NoMatch Then rstpp.AddNew rstpp!iDate = rst!tats rstpp!Payment = rst!mbts rstpp.Update Else rstpp.Edit 'rstpp!iDate = rst!tats rstpp!Payment = rst!mbts rstpp.Update End If rst.MoveNext Next i rstpp.Close: Set rstpp = Nothing rst.Close: Set rst = Nothing DoCmd.OpenQuery "qry_PP" End Sub . وهذه النتيجة: جعفر 231.الرصيد.accdb.zip

هذا من لطفك وإحسانك

حياك الله أستاذ علي ، وعذرا على التأخر في الاجابة نعم تستطيع ان تستخدم الكود كما ذكرت ، ولكن الامر Dlookup ثقيل على البرنامج ، وهو سيستخدم 31 مرة (صحيح الكمبيوترات سريعة هذه الايام ، وقد لا تلاحظ البطئ ) ، ولكني افضل ان نجعله في الكود ، بحيث تفحص اللغة بكود شبيه للذي وضعته انت ، وعلى اساس اللغة تستخدم if else جعفر

هلا والله

تفضل أخي عبدالله تستعمل النموذج ، وتذهب الى السجل الذي تريد ، ثم تنقر على زر تصدير السجل الى الاكسل ، وسيتم حفظ ملف البيانات بصيغة xls وبرقم الشخص ، في نفس مجلد البرنامج ، الكود التالي يقوم بالعمل: Private Sub cmd_to_xls_Click() 'Created by Helen Feddema 8-18-2000 'Last modified 8-18-2000 'File_Name = "c:\" & me.emp_no & ".xls" File_Name = Application.CurrentProject.Path & "\" & Me.emp_no & ".xls" Template_Name = Application.CurrentProject.Path & "\230.Orphan_Details.xlt" On Error GoTo err_cmd_to_xls_Click Dim appExcel As Object 'Excel.Application Dim bks As Object 'Excel.Workbooks Dim wks As Object 'Excel.Worksheet Set appExcel = GetObject(, "Excel.Application") Set bks = appExcel.Workbooks 'Open the workbook bks.Add Template_Name Set wks = appExcel.ActiveSheet 'Write Access data directly to cells in worksheet With wks .Range("B11").Value = Me.first_name .Range("B12").Value = Me.last_name .Range("B13").Value = Me.birth_date .Range("B14").Value = DateDiff("yyyy", CDate(Me.birth_date), Now) .Range("B15").Value = Me.gender End With appExcel.DisplayAlerts = False wks.Saveas FileName:=File_Name, FileFormat:=56 appExcel.Quit appExcel.DisplayAlerts = True 'cleaning up Set appExcel = Nothing Set bks = Nothing Set wks = Nothing ErrorHandlerExit: Exit Sub err_cmd_to_xls_Click: If Err = 429 Then 'Excel is not running; open Excel with CreateObject Set appExcel = CreateObject("Excel.Application") Resume Next Else MsgBox "Error No: " & Err.Number & "; Description: " & Err.Description Resume ErrorHandlerExit End If End Sub . رجاء التأكد ان المرفقين موجودين في مجلد واحد (طبعا تستطيع ان تغيره لاحقا ، بتغيير مساره في الكود) ، سؤال: لماذا لا تصدر البيانات بصيغة pdf بدلا عن الاكسل؟ حيث يمكنك تصدير البيانات من تقرير الاكسس بصيغة pdf مباشرة جعفر 230.Orphan_Details.zip

حياك الله أخوي ، وعذرا على التأخر في الرد

وعليكم السلام تأكد ان الحدث off_AfterUpdate لا يبدأ بـ Private ، وانما يبدأ بـ Public جعفر

أخي وائل خلينا نعطي الاستاذ رمهان استراحة ، والله يخليك جرب المرفق الكود التالي هو اللي يقوم بالعمل: Sub mm(xx) Dim rs As DAO.Recordset Set rs = Me.F_ordersubform.Form.RecordsetClone rs.FindFirst "itemcode='" & xx & "'" 'check if this item is already on the list If rs.NoMatch = False Then Dim Msg, Style, Title, Help, Ctxt, Response, MyString Msg = "هذا الصنف موجود على قائمة الزبون ، هل انتقل الى الصنف الموجود" & vbCrLf & _ "This Item already Exists on the list, should we go there" & vbCrLf & vbCrLf & vbCrLf & _ "Yes = انتقل الى الصنف" & vbCrLf & _ "No = اضف الصنف مرة اخرى" Style = vbYesNoCancel + vbCritical + vbDefaultButton3 ' Define buttons. Title = "الصنف مكرر ، ماذا تريد ان تعمل" ' Define title. Response = MsgBox(Msg, Style, Title) If Response = vbYes Then ' User chose Yes. Me.F_ordersubform.Form.Bookmark = rs.Bookmark 'Me.F_ordersubform!Qty.SetFocus Exit Sub End If End If 'NoMatch جعفر 222.1.KFC.mdb.zip