jjafferr

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

السلام عليكم اختم الموضوع بجمع 3 طرق كما سبق ، ولكن باختلافات بسيطة ، واعرض هنا كيفية عمل جدول مؤقت خارج قاعدة البيانات (طبعا الجدول سيكون في قاعدة بيانات خارجية مؤقتة) ، ثم كيف ربط هذا الجدول المؤقت ببرنامجنا الحالي - تم حذف الجدول المؤقت من البرنامج ، 1. تم إضافة وحدات نمطية 2 (طبعا يمكن الاستغناء عنهم ، وذلك بضمهم لكود النموذج) ، الوحدة النمطية الاولى فيها كود لمناداة بعض مجلدات الوندوز المهمة ، ومنها مجلد Temp ، والذي سنتعامل معه لجميع البرامج/الملفات المؤقته ، والوحدة النمطية الثانية لعمل قاعدة البيانات الخارجية المؤقته ، 2. تم تقسيم عدد الاسطر الى عدد الاسطر والاعمدة ، ليتناسب مع عمل صفحة الانترنت بلغة HTML ، 3. سيقوم بعمل التقرير بواسطة صفحة انترنت بلغة HTML ، 4. سوف يفتح المجلد Temp وسيكون مختار ملف الانترنت الذي تم عمله بالزر رقم 3 ، 5. عمل التقرير بطريقة الاستاذ رمهان ، ولكن باستخدام جدول خارجي مؤقت ، 6. عمل التقرير بطريقة الاستاذ صالح ، ولكن باستخدام جدول خارجي مؤقت ، وهذه الطريقة هي الطريقة المستخدمة غالبا لمعظم الجداول المؤقته ، 7. يفتح المجلد Temp وسيكون مختار قاعدة البيانات الخارجية المؤقتة ، والتي تم عملها بالزرين رقم 5 و 6 ، . التقرير ، ونلاحظ انه لا يوجد له مصدر للبيانات (حيث ان المصدر يعتمد على استخدامنا للزر 5 او 6 ) ، والتقرير كما عمله اخونا ابوخليل ، . هذا كود التقرير: - عند فتحة ، يأخذ مصدر البيانات من المتغير mySQL والذي هو عبارة عن استعلام بصيغة SQL ، والذي يؤخذ من الجدول المؤقت (وسنرى في النموذج هذا الكود) ، - وعند اغلاق التقرير ، نغلق الجدول المؤقت ، وبقية الاستعلامات المحلية التي عُملت على اساسه ، Private Sub Report_Open(Cancel As Integer) Me.RecordSource = mySQL DoCmd.Maximize End Sub Private Sub Report_Unload(Cancel As Integer) On Error GoTo err_Report_Unload Dim OtherDB As Object qrydef.Close CurrentDb.Close 'close the temp_DB sOther = GetWinTemp & "\temp_DB.mdb" Set OtherDB = GetObject(sOther) OtherDB.Application.Quit Exit Sub err_Report_Unload: If Err.Number = 424 Then Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub . الوحدة النمطية لمناداة بعض مجلدات الوندوز المهمة ، ومنها مجلد Temp ، والذي سنتعامل معه لجميع البرامج/الملفات المؤقته ، 'Return Windows directory Function GetWinDir() Set FS = CreateObject("Scripting.FileSystemObject") GetWinDir = FS.GetSpecialFolder(WindowsFolder) Set FS = Nothing End Function 'Return Windows/System directory Function GetWinSys() Set FS = CreateObject("Scripting.FileSystemObject") GetWinSys = FS.GetSpecialFolder(1) Set FS = Nothing End Function 'Return Windows/temp directory Function GetWinTemp() Set FS = CreateObject("Scripting.FileSystemObject") GetWinTemp = FS.GetSpecialFolder(2) Set FS = Nothing End Function 'Return temp filename Function GetTempName() Set FS = CreateObject("Scripting.FileSystemObject") GetTempName = FS.GetTempName Set FS = Nothing End Function 'Return full path and temp filename Function GetTempFullPath() GetTempFullPath = GetWinTemp & "\" & GetTempName Set FS = Nothing End Function . والوحدة النمطية الثانية لعمل قاعدة البيانات الخارجية المؤقته ، وبها وضعنا المتغيرات ، والتي تكون متاحة لكل كائنات قاعدة البيانات ، من نماذج وتقارير ووو Public tbldf As dao.TableDef, qrydf As dao.QueryDef, fld As Field Public rst As dao.Recordset, rst_TQ As dao.Recordset Public sfrm As Form Public wrkAcc As Workspace Public dbsNew As Database Public mdb_Path_Name As String Public mySQL As String Function Make_DB(mdb_Path_Name) On Error GoTo err_Make_DB 'create an empty mdb in the same PC as the FE 'this will allow more than one user to use This DB Set wrkAcc = CreateWorkspace("AccessWorkspace", "admin", "", dbUseJet) ' Make sure there isn't already a file with the name of the new database. If Dir(mdb_Path_Name) <> "" Then Kill mdb_Path_Name ' Create the new database Set dbsNew = wrkAcc.CreateDatabase(mdb_Path_Name, dbLangGeneral) dbsNew.Close wrkAcc.Close Exit Function err_Make_DB: If Err.Number = 3270 Then 'this field does not have a caption for it, give it the field name ElseIf Err.Number = 3024 Or Err.Number = 91 Or Err.Number = 52 Or Err.Number = 53 Or Err.Number = 3055 Then 'mdb, and Table not found to Delete Resume Next ElseIf Err.Number = 3167 Then 'ignor, Records Deleted Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function . هذا كود عمل الزر رقم 3 ، وهو كما وضعته في المشاركة السابقة ، والفرق اني وضعت ملف HTML في مجلد وندوز Temp ، وعملت الملصقات منع: Private Sub cmd_ie_Click() ' 'make Reference to Microsoft Internet Controls 'c:\windows\sysytem32\ieFrame.dll ' Dim web As SHDocVw.InternetExplorerMedium Set web = New SHDocVw.InternetExplorerMedium Dim HTML_File As String 'url header webBody = "<html style='width: 100%; height: 100%;'>" & vbCrLf webBody = webBody & "<head><style>" & vbCrLf '1 here we can change the Font Type, and Font size webBody = webBody & "table {font-family: arial, sans-serif; font-size:15px;border-collapse: collapse; width: 100%;}" & vbCrLf '2 here we can change cell border size, border color, Text alignment 'with black border 'webBody = webBody & "td, th {border: 1px solid #dddddd; text-align: center; padding: 8px;}" & vbCrLf 'without black border webBody = webBody & "td, th {border: 1px solid #FFFFFF; text-align: center; padding: 8px;}" & vbCrLf webBody = webBody & "</style></head><body>" & vbCrLf webBody = webBody & "<table style='width: 100%; height: 100%;'>" & vbCrLf 'How many Rows For i = 1 To Me.Rows 'to create the Table Row webBody = webBody & "<tr>" 'How many columns For j = 1 To Me.columns 'make each cell webBody = webBody & "<th>" & Me.co1.Column(1) & "</th>" Next j 'close the Table Row webBody = webBody & "</tr>" & vbCrLf Next i 'close the HTML code webBody = webBody & "</table></body></html>" 'Debug.Print webBody 'save the HTML file to windows Temp folder HTML_File = GetWinTemp & "\524.webBody.html" Open HTML_File For Output As #1 Print #1, webBody Close #1 'make an IE web.Navigate HTML_File 'wait until the page if fully loaded Do While web.ReadyState <> READYSTATE_COMPLETE Loop web.Stop 'print preview web.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT web.Quit Set web = Nothing End Sub . وهذا كود الزر رقم 4 ، والذي يفتح المجلد Temp وسيكون مختار ملف الانترنت الذي تم عمله بالزر رقم 3 : Private Sub cmd_Temp_Folder_web_Click() HTML_File = GetWinTemp & "\524.webBody.html" 'check if the file exists If Dir(HTML_File, vbNormal) = "" Then MsgBox "الملف غير موجود" Exit Sub End If 'open windows explorer and select the temporary inter file Shell "explorer.exe /select," & HTML_File, vbNormalFocus End Sub . وهذا كود الزر رقم 5 ، طريقة عمل التقرير للاستاذ رمهان بالجدول الخارجي المؤقت Private Sub cmd_Temp_Serial_Click() On Error GoTo err_cmd_Temp_Serial_Click 'طريقة الاستاذ رمهان If Len(Me.co1 & "") = 0 Then MsgBox "رجاء اختيار اسم الملصق" Exit Sub End If '1 'make a temp mdb mdb_Path_Name = GetWinTemp & "\temp_DB.mdb" Call Make_DB(mdb_Path_Name) '2 'Create table tbl_temp with Seq field as Integer. Set dbsNew = OpenDatabase(mdb_Path_Name) dbsNew.Execute "CREATE TABLE tbl_temp " & "(Seq INTEGER);" 'OR we can make a copy of an existing table from currentDB to the new DB 'make a Table temp_DB using "Make Table" query in the DB temp_DB.mdb ' mySQL = "SELECT temp_DB.* INTO tbl_temp IN " & Chr(34) & mdb_Path_Name & Chr(34) ' mySQL = mySQL & " FROM tmp_tbl_Dates_Days" 'Debug.Print mySQL ' DoCmd.SetWarnings False ' DoCmd.RunSQL mySQL ' DoCmd.SetWarnings True '3 'add Records to the temp table Set rst = dbsNew.OpenRecordset("Select * From tbl_temp") 'add one extra Record to meet the criteria For i = 1 To Me.Rows * Me.columns + 1 rst.AddNew rst!Seq = i rst.Update Next i rst.Close: Set rst = Nothing dbsNew.Close '4 'make a temporary query in this DB, from tbl_temp mySQL = "Select * From tbl_temp IN '" & mdb_Path_Name & "'" 'delete the old querydef, if exists CurrentDb.QueryDefs.Delete ("qrydef") 'create a new querydef Set qrydef = CurrentDb.CreateQueryDef("qrydef", mySQL) CurrentDb.Close '5 'make the Report Record Source 'mySQL is declared as Global Variable mySQL = "SELECT tbl1.B_Nm, qrydef.Seq FROM tbl1, qrydef" '6 'now open the Report 'DoCmd.OpenReport "QpNew", acViewPreview, , "[B_Nm]='" & Me.co1.Column(1) & "' And Seq<=" & Me.Rows * Me.columns myCriteria = "B_Nm='" & Me.co1.Column(1) & "'" myCriteria = myCriteria & " And Seq<=" & Me.Rows * Me.columns DoCmd.OpenReport "QpNew", acViewPreview, , myCriteria Exit Sub err_cmd_Temp_Serial_Click: If Err.Number = 3265 Or Err.Number = 3167 Or Err.Number = 3078 Then Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub . وكود عمل التقرير بطريقة الاستاذ صالح ، بالجدول الخارجي المؤقت Private Sub cmd_Temp_Records_Click() 'طريقة الاستاذ صالح حمادي If Len(Me.co1 & "") = 0 Then MsgBox "رجاء اختيار اسم الملصق" Exit Sub End If '1 'make a temp mdb mdb_Path_Name = GetWinTemp & "\temp_DB.mdb" Call Make_DB(mdb_Path_Name) '2 'Create table tbl_temp with B_Nm field as Text. Set dbsNew = OpenDatabase(mdb_Path_Name) dbsNew.Execute "CREATE TABLE tbl_temp " & "(B_Nm Text);" 'OR we can make a copy of an existing table from currentDB to the new DB 'make a Table temp_DB using "Make Table" query in the DB temp_DB.mdb ' mySQL = "SELECT temp_DB.* INTO tbl_temp IN " & Chr(34) & mdb_Path_Name & Chr(34) ' mySQL = mySQL & " FROM tmp_tbl_Dates_Days" 'Debug.Print mySQL ' DoCmd.SetWarnings False ' DoCmd.RunSQL mySQL ' DoCmd.SetWarnings True '3 'add Records to the temp table Set rst = dbsNew.OpenRecordset("Select * From tbl_temp") For i = 1 To Me.Rows * Me.columns rst.AddNew rst!B_Nm = Me.co1.Column(1) rst.Update Next i rst.Close: Set rst = Nothing dbsNew.Close '4 'make the Report Record Source 'mySQL is declared as Global Variable mySQL = "Select * From tbl_temp IN '" & mdb_Path_Name & "'" '5 'now open the Report DoCmd.OpenReport "QpNew", acViewPreview End Sub . واخيرا ، كود الزر رقم 7 ، والذي يفتح المجلد Temp وسيكون مختار قاعدة البيانات الخارجية المؤقتة ، والتي تم عملها بالزرين رقم 5 و 6 ، Private Sub cmd_Temp_Folder1_Click() mdb_Path_Name = GetWinTemp & "\temp_DB.mdb" 'check if the file exists If Dir(mdb_Path_Name, vbNormal) = "" Then MsgBox "الملف غير موجود" Exit Sub End If 'open windows explorer and select the temporary database Shell "explorer.exe /select," & mdb_Path_Name, vbNormalFocus End Sub . جعفر 524.3.rep2.mdb.zip

1. انا لم اقم بتغيير مرفقك ، 2. الكود الذي اعطيتك يقوم بهذه العملية ، فكل الذي عليك فعله هو ادخاله في برنامجك ، 3. ضع الكود التالي على حدث النقر على زر الحقل YesNo في النموذج الفرعي: me.parent.YesNo=me.YesNo . جعفر

شكرا أخي صالح ، ولكن ما تفضلت به هو للإصدار 2007 فما فوق بينما الطلب هنا للأكسس الاقل جعفر

وعليكم السلام المرفق من الرابط التالي: http://www.access-programmers.co.uk/forums/showthread.php?t=180216 كما يمكنك ان تستفيد من هذين الرابطين: https://accessexperts.com/blog/2010/07/21/map-route-on-google-maps-with-addresses-in-access-3/ و http://www.utteraccess.com/forum/index.php?showtopic=2013721&hl=google جعفر Google Map.zip

تفضل طبعا الكود في الرابط السابق لن ينطبق على اي من البرامج ، لأن كل برنامج يختلف بحقوله ، ولكن الفكرة هي التي لا تتغير انا غيرت اسم النوذج الفرعي بدل TblEkaab الى frm_TblEkaab ، حتى لا نتلخبط مع اسم الجدول ، ضع هذا الكود على زر YesNo النموذج الرئيسي: Private Sub YesNo_Click() Dim rst As DAO.Recordset Set rst = Me.frm_TblEkaab.Form.RecordsetClone rst.MoveLast: rst.MoveFirst RC = rst.RecordCount For i = 1 To RC rst.Edit rst!YesNo = Me.YesNo rst.Update rst.MoveNext Next i rst.Close: Set rst = Nothing End Sub . جعفر

وعليكم السلام تفضل جعفر

هلا والله جعفر

وعليكم السلام عملت تغيير بسيط في التقرير: . واستخدمت الكود التالي لإخفاء تذييل مجموعة الغياب : Private Sub GroupFooter1_Format(Cancel As Integer, FormatCount As Integer) If Me.الغياب = 0 Then Cancel = True End If End Sub . وفي الجدول (وللتجربة) ، اضفت 3 ايام لطاهر ، فاصبحت النتيجة: . جعفر 525.التقرير.accdb.zip

أحسن الله الينا وادام نعمه علينا جميعا ان شاء الله ، ومن احببنا جعفر

السلام عليكم أخوي ابوخليل لما تطلع لك نافذة الطباعة: . 1. تقدر تختار عدد صفحات الطباعة: . 2. عندك الخيارات ، حجم الصفحة ، الهوامش (لاحظ الهوامش عندي بالبوصة Inch حسب اعدادات الكمبيوتر) ، والكتابات في اعلا الصحة واسفلها ، وجميع هذه الاعدادات تضبطها لمرة واحدة فقط ، وسيحفظها الكمبيوتر للمرات التالية: . جعفر هذه صورة من الكود الموجود في البرنامج: . 1. نستطيع تغيير نوع الخط Font من هنا ، 2. وحجم الخط ، 3. انا كنت اعمل على عمل حد وبرواز حول الحقول ، ولون البرواز الاسود هو dddddd# ، ثم قمت بتعطيل هذا الكود ، واستبدلت اللون باللون الابيض FFFFFF# ، واستعملت هذا الكود جعفر

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

السلام عليكم هذه طريقة عمل صفحة الانترنت webBrowser ، ويجب ان نتأكد من اختيار : . وهذا الكود يقوم بالعمل: Private Sub cmd_ie_Click() ' 'make Reference to Microsoft Internet Controls 'c:\windows\sysytem32\ieFrame.dll ' Dim web As SHDocVw.InternetExplorerMedium Set web = New SHDocVw.InternetExplorerMedium Dim HTML_File As String 'url header webBody = "<html style='width: 100%; height: 100%;'>" & vbCrLf webBody = webBody & "<head><style>" & vbCrLf '1 here we can change the Font Type, and Font size webBody = webBody & "table {font-family: arial, sans-serif; font-size:15px;border-collapse: collapse; width: 100%;}" & vbCrLf '2 here we can change cell border size, border color, Text alignment 'with black border 'webBody = webBody & "td, th {border: 1px solid #dddddd; text-align: center; padding: 8px;}" & vbCrLf 'without black border webBody = webBody & "td, th {border: 1px solid #FFFFFF; text-align: center; padding: 8px;}" & vbCrLf webBody = webBody & "</style></head><body>" & vbCrLf webBody = webBody & "<table style='width: 100%; height: 100%;'>" & vbCrLf 'How many Rows For i = 1 To Me.Rows 'to create the Table Row webBody = webBody & "<tr>" 'How many columns For j = 1 To Me.columns 'make each cell webBody = webBody & "<th>" & Me.co1.Column(1) & "</th>" Next j 'close the Table Row webBody = webBody & "</tr>" & vbCrLf Next i 'close the HTML code webBody = webBody & "</table></body></html>" 'Debug.Print webBody 'save the HTML file HTML_File = Application.CurrentProject.Path & "\524.webBody.html" Open HTML_File For Output As #1 Print #1, webBody Close #1 'make an IE web.Navigate HTML_File 'wait until the page if fully loaded Do While web.ReadyState <> READYSTATE_COMPLETE Loop web.Stop 'print preview web.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT web.Quit Set web = Nothing End Sub . ولأن العمل كان بالـ HTML ، وانا لا افهم فيه ، فأخذ مني هذا الوقت الكود يعمل ملف مؤقت في مجلد البرنامج ، اسمه 524.webBody.html ونستطيع ان نحذفه برمجيا كلما اغلقنا البرنامج. جعفر 524.2.rep2.mdb.zip

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

تمام ، يعني انا مسؤوليتي العدد فقط جعفر

وعليكم السلام هذه عندي من سنين ، ولا اعرف من اين اتيت بها ، ولم استعملها ، ولا اعرف استعمالها ، ولا ولا .... ، يعني لا تسألني اي شئ عنها جعفر ShapedForm2k.zip wipeeffects2k.zip

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

الحمدلله بعض الاوقات الامر currentdb.execute ما يشتغل لسبب او آخر ، وهو يعمل عمل مجموعة مختلفة من اوامر تشغيل الاستعلامات ، ولكنه يعمل ولا يخبرك اذا كان في اخطاء في الاستعلام ، بينما الامر الآخر docmd.runsql او docmd.openquery ، فانها تخبرك اذا في خطأ ، وتعطيك رسائل التحذير ايضا ، والتي يجب ان نتغلب عليها ، هكذا: docmd.setwarnings false docmd.runsql ("UPDATE esfatora SET done =" & Not Me.done) docmd.setwarnings true جعفر

طيب ممكن توضح اكثر ، ماذا يحدث لما تشغل الكود الذي يشتغل على الاستعلام ، وبالتفصيل؟ جعفر بدل الكود السابق ، استعمل هذا الكود ، واخبرني الخطأ الذي يعطيك: docmd.runsql ("UPDATE esfatora SET done =" & Not Me.done) جعفر

1. نعم 2. نعم ، حل الاستعلام اللي ما اشتغل عندك طيب ، ممكن تخبرني ما هو مصدر النموذج ؟ جعفر

في هذه الحالة يجب ان تستعمل الطريقة رقم 1 في اول مشاركة لي جعفر

حيالله اخونا العود هذا اللي كنت اقصده لما قلت: اما بالنسبة الى المستخدم ، فلن يتدخل في شئ ، والكود المفروض يعمل الشغل كله ، بس لوسمحت تعطيني الاحتمالات ، وان شاء الله اشتغل على الموضوع اما بالنسبة للجدول المؤقت (وطبعا هذه الطريقة الاسهل) ، فالطريقة التي استعملها ، هي ان اعمل برنامج mdb خارجي وفيه الجدول المؤقت ، وبربط الجدول او حتى عن طريق الاستعلام بهذا الجدول الخارجي ، وتكون البيانات جاهزة للعمل كما قمت انت العمل عليها سابقا ، واخي صالح وفكرة اخونا رمهان انت اختار ، واحنا ننفذ ان شاء الله جعفر

السلام عليكم شباب في الواقع عندي حلين غير الجدول المؤقت (انا شخصيا احاول الابتعاد عنه ، لأن تعبئتة ، وحذف البيانات ، وتعبئته ... ، يجعلون البرنامج يكبر بحجمه ، وبالتالي يحتاج الى ضغط لإرجاعه لحجمه العادي) ، الحل الاول: استعمال الاستعلام Union النتيجة: . والحيلة هي تكرار استعلام واحد فقط بعدد المرات التي ارادها اخوي أبوخليل: . واضطررت استخدام 3 استعلامات ، لأن استعلام Union ما رضى بالـ 65 استعلام داخل استعلام واحد طبعا هذه محاولة مبدئية ، فاذا اخوي أبوخليل اراد المضي في هذا الطريق ، فسأحتاج معلومات اكثر علشان اصقل الجواب اما الطريقة الثانية ، واللي سأبدأ المحاولة فيها ، هي استعمال WebBrowser داخل التقرير ، وعمل عدد الحقول فيها مرة واحدة جعفر 524.rep.mdb.zip

تفضل الكود يشتغل ، بس بسبب انك كنت علامة صح بالكود القديم ، فالجدول كله عليه علامة صح ، انا الغيت الصح من الجدول بالكامل ، وارفقت لك البرنامج بكود الاستعلام جعفر 523.Selection.accdb.zip

وعليكم السلام هذا الرابط للأكسس 2007 فما فوق: https://support.office.com/en-us/article/Create-custom-menus-and-shortcut-menus-by-using-macros-5bd538ff-19c4-4dfe-9540-3309aebf8a1a?CorrelationId=efc3d151-69a4-4453-8686-d8a378a3c6ca&ui=en-US&rs=en-US&ad=US&ocmsassetID=HA010282509 جعفر