jjafferr

وعليكم السلام احفظ هذه الوحدة النمطية: Option Compare Database Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias _ "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _ (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long '~~> Constants to be used in our API functions Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0 Private hHook As Long Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, _ ByVal lParam As Long) As Long Dim RetVal Dim strClassName As String, lngBuffer As Long If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If strClassName = String$(256, " ") lngBuffer = 255 If lngCode = HCBT_ACTIVATE Then RetVal = GetClassName(wParam, strClassName, lngBuffer) '~~> Class name of the Inputbox If Left$(strClassName, RetVal) = "#32770" Then '~~> This changes the edit control so that it display the password character *. '~~> You can change the Asc("*") as you please. SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If '~~> This line will ensure that any other hooks that may be in place are '~~> called correctly. CallNextHookEx hHook, lngCode, wParam, lParam End Function Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _ Optional YPos, Optional HelpFile, Optional Context) As String Dim lngModHwnd As Long, lngThreadID As Long lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) InputBoxDK = InputBox(Prompt, Title, Default, XPos, YPos, HelpFile, Context) UnhookWindowsHookEx hHook End Function ثم استدعها من نموذجك هكذا: intinput = InputBoxDK("فضلاً ادخل الرقم السري", "دخول") جعفر وتفضل المرفق بعد اضافة الكود فيه 456.حماية نموذج.mdb.zip

وعليكم السلام شوف هالرابطين ، فقد تستفيد منهم: و جعفر

وعليكم السلام استاذنا الجليل عبدالعزيز كانت عندك معادلة Dsum هنا: . فتم نسخها وتعديل المتغير [Name] الى نموذجك المطلوب فيه التغيير ، ولكن ولأنه حقل محسوب تتغير قيمته طول الوقت ، فإجعله غير مضمن ، ولا تحفظ قيمته في الجدول: . والنتيجة . جعفر 453.Aziz.accdb.zip

مع الاعتذار لك أخي عبدالله ، هذا الموضوع سوف يُغلق ، لأنه مكرر: جعفر

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

وعليكم السلام اليك الاجابة بالصور ، ويمكنك التعديل كما تشاء . . . . جعفر 454.معرفة المكرر من البيانات.accdb.zip

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

وعليكم السلام اليك الاجابة بالصور . . . . . . . . جعفر 452.ترتيب سجلات التقرير نفس ترتيب سجلات النموذج الفرعي.mdb.zip

السلام عليكم اخي BFS 1. تم نقل سؤالك كموضوع مستقل في قسم الاكسس (كما اشار عليك الاخ محمد ايمن ، شكرا اخي محمد) ، هنا https://www.officena.net/ib/topic/73627-بحث-بالحرف-الابجدى/ 2. قوانين المنتدى لا تسمح بوضع اكثر موضوع لنفس السؤال. جعفر

السلام عليكم تم نقل السؤال هنا كموضوع مستقل جعفر

وعليكم السلام احنا لما نسمع واحد يتأوه ، نقول له: بسم الله عليك حياك الله جعفر

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

تفضل وهذا الكود يضيف لك السجل الجديد: Private Sub cmd_Add_Record_to_SubForm_Click() Forms!frm_Q1!sub_swet.SetFocus DoCmd.GoToRecord , , acNewRec End Sub جعفر 451.مثال.accdb.zip

وعليكم السلام هذه امثلة عن الطريقة: http://arabteam2000-forum.com/index.php?/topic/282771-استيراد-البيانات-من-صفحة-ويب/ و http://arabteam2000-forum.com/index.php?/topic/243087-استيراد-البيانات-من-النت-إلى-قاعدة-أكسس/ وطبعا لازم تشمر عن ساعديك وتدخل فيها بالمليان جعفر

وتفضل هذا نموذج جاهز ، فما عليك الا: 1- تعبئة البيانات المطلوبة ، من اسم الجدول او الاستعلام ، ومكان الحفظ ، وصيغة الحفظ ، ووو او 2- تستخدم دالة كود النموذج ، وترسل المطلوب عن طريق الكود اليها (انا لم اشر الى هذا في الموضوع السابق) ، وهذا الكود من البرنامج المرفق: هذه بعض المتغيرات ، والمتغيرات الباقية مأخوذة مباشرة من النموذج i_strSql = "Select * From " & Me.cmb_TQ_Name i_strWorkSheet = Nz(Me.cmb_Sheet_Name, "") i_strCellRef = Nz(Me.cmb_Upper_Left_cell, "") i_strSaveAs = Nz(Me.cmb_SaveFormat, "") وهكذا تستطيع ان تنادي الدالة ، فتقوم بالعمل بدل من استخدام النموذج Call CopyRs2Sheet(i_strSql, i_strWorkBook, _ i_strWorkSheet, _ i_strCellRef, _ i_strSaveAs, _ Me.frm_Auto_Fit, _ Me.frm_Delete_Exisiting_File, _ Me.Open_The_File_on_Completion) جعفر

وهذه مشاركة مع اخي شفان اذا اردت اسماء الحقول تظهر في اعلى اعمدة الاكسل DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Table1", "D:\Temp\my.xlsx", True وبدون اسماء الحقول DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Table1", "D:\Temp\my.xlsx", False جعفر

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

تفضل جرب هذا الكود myCriteria = "[نوع الكتاب]='aa'" myCriteria = myCriteria & " And Year([حقل التاريخ])=" & Year(date()) a = DMax("[حقل رقم الوارد]", "Tbl_Main", myCriteria) جعفر

السلام عليكم الرابط التالي يعطيك مثال في كيفية عمل اكثر من شرط للدالة Dlookup والتي تستطيع استخدام الدالة Dmax بدلا عنها في المثال: جعفر

السلام عليكم اخوي ابوخليل اسمح لي ادخل في النص ، واحاول اطبق الفكرة اللي شرحتها هنا: في المرفق ، يوجد زر اسمه "وزّع" ، وذلك لعمل سجلات الاجازات للجدول tbl_mn7_Details ، وذلك لمنح الاجازة ، وزر "استقطع" ، وذلك للتأشير على السجلات التي سوف تُستقطع من الاجازات الممنوحة ، في الجدول tbl_mn7_Details . الآن ، الجدول tbl_mn7_Details به الاجازات الممنوحة ، والمستقطعة ، لذلك يمكن عمل استعلام لحساب الاشياء الاخرى المطلوبة أعتذر مسبقا عن عدم تمكني من عمل اي شئ إضافي ، لأني على سفر بعد اقل من 11 ساعة ولمدة عدة اسابيع جعفر 413.الاجازات.mdb.zip

وعليكم السلام الكود يقوم بفتح الملف الموجود مساره واسمه في الحقل DTPath فمثلا الملف التالي سيفتحه الكود اعلاه بإستخدام البرنامج الافتراضي في الوندوز لفتح هذه الصيغة: DTPath= "F:\Officena\Report_Time.txt" جعفر

السلام عليكم تكملة للتجربة اعلاه ، وبعد وضع كود جديد في المشاركة الاخيرة ، وهذا الكود يعتمد على انشاء جدول مؤقت ، اضع لكم النتائج: 1-7-2016 to 30-7-2016 j = 335.2969 R = 239.1992 Transpose = 148.8281 والكود على هيئة دالة Option Compare Database Function transposer() 'http://www.access-programmers.co.uk/forums/showpost.php?p=907107&postcount=15 'Edited by jjafferr on 22-7-2016 Dim db As DAO.Database Dim tdfNewDef As DAO.TableDef Dim fldNewField As DAO.Field Dim rstSource As DAO.Recordset Dim rstTarget As DAO.Recordset Dim i As Integer, j As Integer Dim strSource As String Dim strTarget As String Dim sqlcode As String Dim t_array() As Variant Dim t_no_of_rows As Integer Dim t_no_of_columns As Integer Dim s_no_of_rows As Integer Dim s_no_of_columns As Integer Dim T As Long On Error GoTo Transposer_Err 'strSource = "tbl_input" strSource = "qry_blagh_2" strTarget = "tbl_output" Set db = CurrentDb() 'Set rstSource = db.OpenRecordset("SELECT * FROM tbl_input ORDER BY sample_type", dbOpenDynaset) Set rstSource = db.OpenRecordset("SELECT * FROM " & strSource, dbOpenDynaset) rstSource.MoveLast t_no_of_rows = rstSource.Fields.count t_no_of_columns = rstSource.RecordCount + 1 s_no_of_columns = rstSource.Fields.count s_no_of_rows = rstSource.RecordCount + 1 DoCmd.SetWarnings False sqlcode = "DELETE tbl_output.* FROM tbl_output" DoCmd.RunSQL sqlcode DoCmd.SetWarnings True ReDim t_array(t_no_of_rows, t_no_of_columns) ' Fill the first field of the array with ' field names from the original table. For i = 0 To t_no_of_rows - 1 t_array(i, 0) = rstSource.Fields(i).Name Next i rstSource.MoveFirst ' Fill each column of the array ' with a record from the original table. For j = 0 To t_no_of_rows - 1 ' Begin with the second field, because the first field ' already contains the field names. For i = 1 To t_no_of_columns - 1 ' Debug.Print i & " " & j t_array(j, i) = rstSource.Fields(j) rstSource.MoveNext Next i rstSource.MoveFirst Next j ' Fill the target table with fields from the array Set rstTarget = db.OpenRecordset(strTarget) For j = 0 To t_no_of_rows - 1 rstTarget.AddNew T = 0 For i = 0 To t_no_of_columns - 1 'rstTarget.Fields(i) = t_array(j, i) rstTarget.Fields(i + 1) = t_array(j, i) 'j If j > 0 And IsNumeric(t_array(j, i)) Then T = T + Val(t_array(j, i)) End If Next i rstTarget!Totals = T rstTarget.Update Next j db.Close 'MsgBox ("finished") Exit Function Transposer_Err: Select Case Err Case 3061 'Too Few parameters, expect 2 Set db = CurrentDb Set qdf = db.QueryDefs(strSource) For Each prm In qdf.Parameters prm.Value = Eval(prm.Name) Next prm Set rstSource = qdf.OpenRecordset(dbOpenDynaset) Resume Next Case 3010 MsgBox "The table " & strTarget & " already exists." Case 3078 MsgBox "The table " & strSource & " doesn't exist." Case Else MsgBox CStr(Err) & " " & Err.Description End Select Exit Function End Function اما الجدول المؤقت فهكذا شكله: وهذه نتيجته جعفر

السلام عليكم أخي صالح ، شرحك هو حول الامر NZ هنا تحدثت عن هذا الامر: فالدالة Len هي لحساب عدد الحروف في حقل او قيمة ، بغض النظر عن نوع الحقل ، نص او رقم او تاريخ او .. جعفر

تستطيع استعمال اي من هذه الطرق الثلاث: Private Sub أمر1_Click() 'On Error Resume Next '1. ' Me.dd.SetFocus ' DoCmd.GoToRecord , , acNext '2. Me.dd.Form.Recordset.MoveNext '3. ' Me.dd.SetFocus ' DoCmd.RunCommand acCmdRecordsGoToNext End Sub Private Sub أمر3_Click() On Error Resume Next '1. ' Me.dd.SetFocus ' DoCmd.GoToRecord , , acPrevious '2. Me.dd.Form.Recordset.MovePrevious '3. ' Me.dd.SetFocus ' DoCmd.RunCommand acCmdRecordsGoToPrevious End Sub جعفر

وعليكم السلام Option Compare Database Private Sub أمر1_Click() On Error Resume Next Me.dd.SetFocus DoCmd.GoToRecord , , acNext End Sub Private Sub أمر3_Click() On Error Resume Next Me.dd.SetFocus DoCmd.GoToRecord , , acPrevious End Sub جعفر