jjafferr

جربي المرفق واخبرينا عن النتائج جعفر

تفضل الكود على حدث نقر زر "تفعيل خانة الاختيار في النموذج الفرعي": Dim rst As DAO.Recordset Set rst = Me.ORDER.Form.RecordsetClone rst.MoveLast: rst.MoveFirst RC = rst.RecordCount What_Was_The_First_Selection = rst!Do For i = 1 To RC rst.Edit rst!Do = Not What_Was_The_First_Selection rst.Update rst.MoveNext Next i rst.Close: Set rst = Nothing جعفر 528.CHECK BOX.accdb.zip

وعليكم السلام أخي محمد هذا ما قاله صاحب الموضوع: و جعفر

تفضلي 1. عملنا نموذج فيه التاريخ من/الى ، 2. عملنا استعلام مجموعي ، لحساب عدد الغياب فقط بين التاريخين ، والموظف الذي يملك عدد غياب اكبر من يومين ، يتم ارسال اسمه الى الوحدة النمطية Check_Abs . تقوم الوحدة النمطية بمقارنة اليوم rst!Date ، باليوم السابق + يوم (DateAdd("d", 1, Prev_Date)، واذا كانت النتيجة متساوية ، يقوم العداد Seq بجمع الايام ، Function Check_Abs(EN) 'EN = Employee Name Dim rst As DAO.Recordset fD = [Forms]![frm_Days]![Date_From] eD = [Forms]![frm_Days]![Date_To] myCriteria = "[Emp_Name]='" & EN & "'" myCriteria = myCriteria & " And [Leave_Type]='غياب'" myCriteria = myCriteria & " And [Date] Between " & DateFormat(fD) & " And " & DateFormat(eD) 'Set rst = CurrentDb.OpenRecordset("Select * From Enterans_Absent Where [Emp_Name]='" & EN & "' And [Leave_Type]='غياب' And [Date] Between '" & DateFormat(fD) & "' And '" & DateFormat(eD) & "'") Set rst = CurrentDb.OpenRecordset("Select * From Enterans_Absent Where " & myCriteria & " Order by [Date]") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount Seq = 1 Prev_Date = rst![Date] For i = 1 To RC If rst![Date] = DateAdd("d", 1, Prev_Date) Then Seq = Seq + 1 End If Prev_Date = rst![Date] rst.MoveNext Next i If Seq >= 3 Then Check_Abs = Seq & " ايام متتالية" Else Check_Abs = RC & " ايام غير متتالية" End If rst.Close: Set rst = Nothing End Function . والنتيجة: . جعفر 527.مثال 5.accdb.zip

وعليكم السلام اختي لوسمحتي تعطينا معلومات اكثر عن طلبك: 1. هل سوف تطلبين البيانات بين تاريخين؟ 2. اذا كان جوابك نعم ، واذا طلبتي البيانات لفترة شهر مثلا ، وكان هناك 3 ايام غياب متتايه ولكن لأكثر من مرة ، فماذا تريدين شكل رسالة التنبيه؟ 3. كم عدد الموظفين جميعا تقريبا؟ جعفر

السلام عليكم أخي صالح هذه المعلومة تقريبا صحيحة ، والصحيح 1 سم يساوي 567 وحدة تويب ، ولكن يجب عليك الحذر ، حيث ان 1 بوصة Inch يساوي 1440 تويب ، مثلا: عند عملك البرنامج ، وتريد ان تأخذ قيمة عرض الحقل (مثلا) وتتلاعب به ، فمن المهم ان تعرف ان هذه القيمة بالسنتيمتر او البوصة (لا تنسى ان لكل كمبيوتر تنصيب يختلف عن الآخر ، وبحسب الدولة التي هو فيها كذلك) انا استعمل الوحدة النمطية التالية لأحصل على بعض معلومات الكمبيوتر ، منها وحدة القياس: Option Compare Database ' This code was originally written by Dev Ashish. ' It is not to be altered or distributed, ' except as part of an application. ' You are free to use it in any application, ' provided the copyright notice is left unchanged. ' ' Code Courtesy of ' Dev Ashish ' Public Const LOCALE_ILANGUAGE = &H1 ' language id Public Const LOCALE_SLANGUAGE = &H2 ' localized name of language Public Const LOCALE_SENGLANGUAGE = &H1001 ' English name of language Public Const LOCALE_SABBREVLANGNAME = &H3 ' abbreviated language name Public Const LOCALE_SNATIVELANGNAME = &H4 ' native name of language Public Const LOCALE_ICOUNTRY = &H5 ' country code Public Const LOCALE_SCOUNTRY = &H6 ' localized name of country Public Const LOCALE_SENGCOUNTRY = &H1002 ' English name of country Public Const LOCALE_SABBREVCTRYNAME = &H7 ' abbreviated country name Public Const LOCALE_SNATIVECTRYNAME = &H8 ' native name of country Public Const LOCALE_IDEFAULTLANGUAGE = &H9 ' default language id Public Const LOCALE_IDEFAULTCOUNTRY = &HA ' default country code Public Const LOCALE_IDEFAULTCODEPAGE = &HB ' default code page Public Const LOCALE_SLIST = &HC ' list item separator Public Const LOCALE_IMEASURE = &HD ' 0 = metric, 1 = US Public Const LOCALE_SDECIMAL = &HE ' decimal separator Public Const LOCALE_STHOUSAND = &HF ' thousand separator Public Const LOCALE_SGROUPING = &H10 ' digit grouping Public Const LOCALE_IDIGITS = &H11 ' number of fractional digits Public Const LOCALE_ILZERO = &H12 ' leading zeros for decimal Public Const LOCALE_SNATIVEDIGITS = &H13 ' native ascii 0-9 Public Const LOCALE_SCURRENCY = &H14 ' local monetary symbol Public Const LOCALE_SINTLSYMBOL = &H15 ' intl monetary symbol Public Const LOCALE_SMONDECIMALSEP = &H16 ' monetary decimal separator Public Const LOCALE_SMONTHOUSANDSEP = &H17 ' monetary thousand separator Public Const LOCALE_SMONGROUPING = &H18 ' monetary grouping Public Const LOCALE_ICURRDIGITS = &H19 ' # local monetary digits Public Const LOCALE_IINTLCURRDIGITS = &H1A ' # intl monetary digits Public Const LOCALE_ICURRENCY = &H1B ' positive currency mode Public Const LOCALE_INEGCURR = &H1C ' negative currency mode Public Const LOCALE_SDATE = &H1D ' date separator Public Const LOCALE_STIME = &H1E ' time separator Public Const LOCALE_SSHORTDATE = &H1F ' short date format string Public Const LOCALE_SLONGDATE = &H20 ' long date format string Public Const LOCALE_STIMEFORMAT = &H1003 ' time format string Public Const LOCALE_IDATE = &H21 ' short date format ordering Public Const LOCALE_ILDATE = &H22 ' long date format ordering Public Const LOCALE_ITIME = &H23 ' time format specifier Public Const LOCALE_ICENTURY = &H24 ' century format specifier Public Const LOCALE_ITLZERO = &H25 ' leading zeros in time field Public Const LOCALE_IDAYLZERO = &H26 ' leading zeros in day field Public Const LOCALE_IMONLZERO = &H27 ' leading zeros in month field Public Const LOCALE_S1159 = &H28 ' AM designator Public Const LOCALE_S2359 = &H29 ' PM designator Public Const LOCALE_SDAYNAME1 = &H2A ' long name for Monday Public Const LOCALE_SDAYNAME2 = &H2B ' long name for Tuesday Public Const LOCALE_SDAYNAME3 = &H2C ' long name for Wednesday Public Const LOCALE_SDAYNAME4 = &H2D ' long name for Thursday Public Const LOCALE_SDAYNAME5 = &H2E ' long name for Friday Public Const LOCALE_SDAYNAME6 = &H2F ' long name for Saturday Public Const LOCALE_SDAYNAME7 = &H30 ' long name for Sunday Public Const LOCALE_SABBREVDAYNAME1 = &H31 ' abbreviated name for Monday Public Const LOCALE_SABBREVDAYNAME2 = &H32 ' abbreviated name for Tuesday Public Const LOCALE_SABBREVDAYNAME3 = &H33 ' abbreviated name for Wednesday Public Const LOCALE_SABBREVDAYNAME4 = &H34 ' abbreviated name for Thursday Public Const LOCALE_SABBREVDAYNAME5 = &H35 ' abbreviated name for Friday Public Const LOCALE_SABBREVDAYNAME6 = &H36 ' abbreviated name for Saturday Public Const LOCALE_SABBREVDAYNAME7 = &H37 ' abbreviated name for Sunday Public Const LOCALE_SMONTHNAME1 = &H38 ' long name for January Public Const LOCALE_SMONTHNAME2 = &H39 ' long name for February Public Const LOCALE_SMONTHNAME3 = &H3A ' long name for March Public Const LOCALE_SMONTHNAME4 = &H3B ' long name for April Public Const LOCALE_SMONTHNAME5 = &H3C ' long name for May Public Const LOCALE_SMONTHNAME6 = &H3D ' long name for June Public Const LOCALE_SMONTHNAME7 = &H3E ' long name for July Public Const LOCALE_SMONTHNAME8 = &H3F ' long name for August Public Const LOCALE_SMONTHNAME9 = &H40 ' long name for September Public Const LOCALE_SMONTHNAME10 = &H41 ' long name for October Public Const LOCALE_SMONTHNAME11 = &H42 ' long name for November Public Const LOCALE_SMONTHNAME12 = &H43 ' long name for December Public Const LOCALE_SABBREVMONTHNAME1 = &H44 ' abbreviated name for January Public Const LOCALE_SABBREVMONTHNAME2 = &H45 ' abbreviated name for February Public Const LOCALE_SABBREVMONTHNAME3 = &H46 ' abbreviated name for March Public Const LOCALE_SABBREVMONTHNAME4 = &H47 ' abbreviated name for April Public Const LOCALE_SABBREVMONTHNAME5 = &H48 ' abbreviated name for May Public Const LOCALE_SABBREVMONTHNAME6 = &H49 ' abbreviated name for June Public Const LOCALE_SABBREVMONTHNAME7 = &H4A ' abbreviated name for July Public Const LOCALE_SABBREVMONTHNAME8 = &H4B ' abbreviated name for August Public Const LOCALE_SABBREVMONTHNAME9 = &H4C ' abbreviated name for September Public Const LOCALE_SABBREVMONTHNAME10 = &H4D ' abbreviated name for October Public Const LOCALE_SABBREVMONTHNAME11 = &H4E ' abbreviated name for November Public Const LOCALE_SABBREVMONTHNAME12 = &H4F ' abbreviated name for December Public Const LOCALE_SABBREVMONTHNAME13 = &H100F Public Const LOCALE_SYSTEM_DEFAULT& = &H800 Public Const LOCALE_USER_DEFAULT& = &H400 Const cMAXLEN = 255 Private Declare Function apiGetLocaleInfo Lib "kernel32" _ Alias "GetLocaleInfoA" (ByVal Locale As Long, _ ByVal LCType As Long, ByVal lpLCData As String, _ ByVal cchData As Long) As Long '''' Function CountryName() As String Dim lngLocale As Long Dim strLCData As String, lngData As Long Dim lngX As Long strLCData = String$(cMAXLEN, 0) lngData = cMAXLEN - 1 lngX = GetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_SCOUNTRY, strLCData, lngData) If lngX <> 0 Then CountryName = Left$(strLCData, lngX - 1) End If End Function '''' Function fLocaleInfo(lngLCType As Long) As String Dim lngLocale As Long Dim strLCData As String, lngData As Long Dim lngX As Long strLCData = String$(cMAXLEN, 0) lngData = cMAXLEN - 1 lngX = apiGetLocaleInfo(LOCALE_USER_DEFAULT, lngLCType, _ strLCData, lngData) If lngX <> 0 Then fLocaleInfo = Left$(strLCData, lngX - 1) End If End Function Function fLOCALE_IMEASURE() As String ' 0 = metric, 1 = US Dim lngLocale As Long Dim strLCData As String, lngData As Long Dim lngX As Long strLCData = String$(cMAXLEN, 0) lngData = cMAXLEN - 1 lngX = apiGetLocaleInfo(LOCALE_USER_DEFAULT, LOCALE_IMEASURE, _ strLCData, lngData) If lngX <> 0 Then fLOCALE_IMEASURE = Left$(strLCData, lngX - 1) End If End Function . وطريقة استخدامي لوحدة القياس في النموذج هكذا: 'call the function to Get the Unit of Measurment from Windows Regional Measurment If fLOCALE_IMEASURE = 0 Then '0 = metric t = 567 Else '1 = US t = 1440 End If . جعفر

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

السلام عليكم اختم الموضوع بجمع 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) جعفر