اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

jjafferr

أوفيسنا
  • Posts

    9903
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    404

كل منشورات العضو jjafferr

  1. وعليكم السلام انا قلت . انت قلت . عليه ، اصبحت المعادلة: . والان الى برنامجك: . . والطريقة الوحيدة للتأكد 100% هو الرجوع للجدول ومعرفة نوع الحقل: . يعني fsl نص وليس رقم يالله نرجع نصلح المعادلة في النموذج ، ونخلي fsl نص بدل مايكون رقم: . والنتيجة . جعفر 277.sart.accdb.zip
  2. هل يوجد سجل بهذه المعلومات؟ هذه الرسالة عادة تظهر إذا ما في بيانات في التقرير. جعفر واذا كانت المعلومات موجودة ، فرجاء إرفاق برنامجك للنظر فيه. جعفر
  3. وعليكم السلام أخي طارق عملت وحدة نمطية fget_User_ID : Option Compare Database Public u_ID As Integer ' Function get_User_ID() get_User_ID = u_ID End Function . في نموذج دخول المستخدمين ، ارسلت قيمة u_ID الى الوحدة النمطية اعلاه: Private Sub Command5_Click() If [n2] = [كلمة السر] Then 'assign this value to a Global variable in module fget_User_ID u_ID = Me.iduser DoCmd.OpenForm "واجهة البرنامج", acNormal [Forms]![واجهة البرنامج]![n1] = [Forms]![دخول المستخدمين]![الاسم الكامل] DoCmd.Close acForm, "دخول المستخدمين" Else ms$ = "كلمة السر غير مطابقة" ti$ = "كلمة السر خطأ" re = MsgBox(ms$, 0, ti$) End If End Sub . فمن الآن وصاعدا ، كلما اردنا قيمة createuser ، فما علينا إلا ان ننادي الوحدة النمطية الاولى ، لهذا وفي نموذج الادخال barcodeir ، اصبح حقل createuser هكذا: . وفي حدث الحقل barcode ، الحدث On Lost Focus ، استدعيت قيمة createuser من الوحدة النمطية fget_Used_ID ، هكذا: Private Sub barcode_LostFocus() 'only split is nfous is empty If Len(Me.nfousi & "") <> 0 Then Exit Sub Dim x() As String Dim p As Integer If Me.barcode <> "" Then 'get the userID Me.createuser = get_User_ID() x1 = Replace(Me.barcode, "*", "") Debug.Print x1 x = Split(x1, "-") Debug.Print x(2) Me.nfousi = DLookup("[NoufousName]", "NoufousTable", "[Field]='" & x(0) & "'") ' Me.nfous_ID = DLookup("[NoufousID]", "NoufousTable", "[Field1]='" & x(0) & "'") Me.irsalieh = x(2) Me.createdate = Date Me.[a1] = x(1) ' Me.[000000] = x(2) ' Me.[000] = x(3) Me.[101] = x(3) End If End Sub . جعفر 276.tito.accdb.zip
  4. وعليكم السلام الرابط التالي يشرح لك الطريقة: http://www.officena.net/ib/topic/5106-ت-فتح-تقرير-مع-شرط/#comment-26881 http://access.mvps.org/access/reports/rpt0006.htm جعفر
  5. وعليكم السلام فكرة: ادخل اسم الكاشير مع كل عملية جعفر
  6. تفضل عملنا جدول جديد مؤقت للطباعة tbl_Temp وفيه الحقول المطلوبة لطباعة الباركود: . فاصبح علينا في الكود ان نحذف جميع سجلات هذا الجدول ، ثم نضيف بيانات الباركود الجديد ، على حسب عدد السجلات المطلوبة ، وبعدها نفتح التقرير ، والذي عملنا مصدره tbl_Temp . والكود اصبح: Private Sub PRENT_Click() If Me.t3 = 0 Then MsgBox ("لابد ان يكون حقل عدد الملصقات اكبر من صفر") End If 'delete the tbl_Temp Records mySQL = "Delete * From tbl_Temp" CurrentDb.Execute (mySQL) 'add the number of Records Dim rst As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Select * From tbl_Temp") For i = 1 To Me.t3 rst.AddNew rst!SMALL_UNIT_PRICE = Me.SMALL_UNIT_PRICE rst!uuu = Me.uuu rst!uun = Me.uun rst!ITEM_CODE = Me.ITEM_CODE rst!ITEM_BARCODE = Me.ITEM_BARCODE rst!FACTOR = Me.FACTOR rst!ITEM_NAME2 = Me.ITEM_NAME2 rst!SUPP_CODE = Me.SUPP_CODE rst.Update Next i rst.Close: Set rst = Nothing 'now print the Report DoCmd.OpenReport "medicine" End Sub . السبب ان هذه الطريقة اسرع في الطباعة ، لأننا نرسل جميع السجلات الى التقرير مرة واحدة ، فالى الطابعة ، بينما في الطريقة السابقة ، كان هناك سجل واحد فقط في التقرير ، وكنا نفتح ونغلق التقرير عدة مرات لطباعة الباركود الواحد. وهنا اود ان ارفع الى اختنا الفاضلة الدكتورة أم عهود كل تحية واجلال واحترام لبُعد نظرها وبراعتها ، لأني اتذكر في منتدى الفريق العربي للبرمجة ، في موضوع طباعة الباركود ، انها عملت الكود لتحفظ سجلات الباركود في جدول مؤقت ، وانا وبسبب قلة خبرتي قلت انه من الافضل عدم عمل الجدول ، والطلب من التقرير الطباعة مباشرة (مثل ما عملنا سابقا) ، والآن فقط عرفت السبب ، وهو سرعة/بطئ الطباعة جعفر 272.BARCODE.accdb.zip
  7. وعليكم السلام كل رسالة خطأ ، لها رقم ، وتظهر الرسالة في اماكن مختلفة ، فاذا عرفت الحدث الذي تطلع الرسالة فيه ، وما يهمك تحل سبب الرسالة ، تستطيع ان تضع السطر التالي على السطر الثاني من الحدث: Private sub ...... on error resume next جعفر
  8. وعليكم السلام نعم ممكن ، وذلك بعمل جدول مؤقت للطباعة ويكون مصدر التقرير medicine في النموذج Form8 ، وعند النقر على الزر "طباعة باركود" ، فيجب ان نعمل سجلات بالعدد المطلوب في الجدول المؤقت ، ثم نعطي زر الطباعة DoCmd.OpenReport "medicine" حيث ان الجدول سيحتوي على عدد السجلات المطلوبة مباشرة ، بينما نحن الان ، نطلب منه ان يطبع ، ثم يطبع ، ثم يطبع ، ثم ... جعفر
  9. السلام عليكم أخي إسلام مادام صار عندك فضول في فهم قوة الاستعلام ، اليك هذا الرابط: http://www.officena.net/ib/topic/65067-ما-هي-طريقة-استيراد-بيانات-من-عدة-صفحات-اكسل-الى-جدول-اكسس/?do=findComment&comment=423657 جعفر
  10. السلام عليكم . هذا صحيح ، ولكن في نهاية الدالة تستطيع تختار النطاق Range او الورقة/sheet ، فعليه يمكنك ان تعيد الامر اكثر من مرة ، كل مرة لورقة اكسل اخرى (لاحظ اسماء الـSheet): DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet1$" DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet2$" DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet3$" . ولكن هذا الامر يتطلب منا ان نعرف عدد الاوراق/Sheets ، واسمائها ------------------------------------------------------------------------------------------------------------------------ والآن لشرح ما عملته انا: 1. عملت جدول اسمه tbl_Sheets ، لإدخال جميع المعلومات في جميع الاوراق/Sheets: . وعن طريق الكود (الكود سيكون في نهاية الموضوع) ، يأخذ البيانات ، فيصبح: . ثم يأتي الكود مرة اخرى ، فيملئ حقل ID لكل علامة: . ثم عملت استعلام جدولي CrossTab ، والذي به نستطيع ان نجعل بيانات احد الاعمدة عبارة عن اعمدة متفرقة ، يعني الحقل F1 ، اردنا ان نجعل كل مادة عبارة عن عمود مستقل): . وهذه نتائجه: . والان الى عمل استعلام آخر ، لجمع كل هذه السجلات: . فاصبحت: . الآن وقد اصبحت البيانات جاهزة لإلحاقها بالجدول النهائي Degrees ، نعمل استعلام الحاقي: . والكود الذي يقوم بكل العمل: Private Sub ImportData_Click() 'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet1$" 'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet2$" 'DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "tbl_Sheets", Me.txtPath, False, "Sheet3$" Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean Dim lngCount As Long Dim objExcel As Object, objWorkbook As Object Dim colWorksheets As Collection Dim strPathFile As String, strTable As String Dim strPassword As String ' Establish an EXCEL application object On Error Resume Next Set objExcel = GetObject(, "Excel.Application") If Err.Number <> 0 Then Set objExcel = CreateObject("Excel.Application") blnEXCEL = True End If Err.Clear On Error GoTo 0 ' Change this next line to True if the first row in EXCEL worksheet ' has field names blnHasFieldNames = False ' Replace C:\Filename.xls with the actual path and filename strPathFile = Me.txtPath ' "C:\Filename.xls" ' Replace tablename with the real name of the table into which ' the data are to be imported strTable = "tbl_Sheets" '"tablename" ' Replace passwordtext with the real password; ' if there is no password, replace it with vbNullString constant ' (e.g., strPassword = vbNullString) strPassword = vbNullString '"passwordtext" blnReadOnly = True ' open EXCEL file in read-only mode ' Open the EXCEL file and read the worksheet names into a collection Set colWorksheets = New Collection Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _ strPassword) For lngCount = 1 To objWorkbook.Worksheets.Count colWorksheets.Add objWorkbook.Worksheets(lngCount).Name Next lngCount ' Close the EXCEL file without saving the file, and clean up the EXCEL objects objWorkbook.Close False Set objWorkbook = Nothing If blnEXCEL = True Then objExcel.Quit Set objExcel = Nothing ' Import the data from each worksheet into the table For lngCount = colWorksheets.Count To 1 Step -1 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ strTable, strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$" Next lngCount ' Delete the collection Set colWorksheets = Nothing '--------------------------------- ' importing is finished 'now organize the table, by adding the ID to all the group Dim rst As DAO.Recordset Set rst = CurrentDb.OpenRecordset("Select * From tbl_Sheets") rst.MoveLast: rst.MoveFirst RC = rst.RecordCount For i = 1 To RC If rst!F1 = "رقم الهوية" Then 'And Len(rst!ID & "") = 0 Then myID = rst!F2 rst.Edit rst!ID = myID rst.Update Else rst.Edit rst!ID = myID rst.Update End If rst.MoveNext Next i rst.Close: Set rst = Nothing 'append the data DoCmd.SetWarnings False DoCmd.OpenQuery "qry_Append_Sheets" DoCmd.SetWarnings True MsgBox "Done" ' Uncomment out the next code step if you want to delete the ' EXCEL file after it's been imported ' Kill strPathFile End Sub . . ولكن ، يجب عليك ان تحذف بيانات الجداول Degree و tbl_Sheets قبل ان تقوم بأي عمل جعفر 275.ImportDegrees.accdb.zip
  11. تفضل If Len(Me.dd & "") = 0 Or Len(Me.sf & "") = 0 Then MsgBox "اختر اسم من القائمة" Exit Sub Else DoCmd.OpenReport "tgweemmstmr", acViewPreview, , "[alsaf]='" & Me.dd & "' And [fsl]=" & Me.sf End If جعفر
  12. بس ان شاء الله اخونا العود ابو خليل ما يشوف هذا الرد ، لأني بكون مخالف (لأن قوانين المنتدى لا تسمح بأكثر من سؤال في موضوع واحد ) . لا فرق ، ولكن تأكد انك ممكن تضيف للاستعلام (يعني افتح الاستعلام وحاول تغير احد البيانات او تضيف سجل جديد ، فإذا صار التعديل ، فالنموذج يمكنه التعديل والاضافة ، واذا الاستعلام ما قبل التعديل والاضافة ، فلا تلوم النموذج ) جعفر
  13. عفوا الظاهر ما فهمت قصدك يعني المستخدم لازم يختار من القائمتين ، ثم يفتح التقرير؟ ويفتح التقرير على اساس الحقلين alsaf و fsl ؟ جعفر
  14. وعليكم السلام نفترض ان الحقل Name_ID هو الحقل الذي تعتمد عليه في اختيار سجلاتك ، اعمل استعلام جديد ، واختر الجدول data1 ، غيّر الاستعلام الى استعلام الحاقي للجدول data2 ، واضف الحقول التي تريدها ، والبرنامج سيضيف الحقول المتشابهة بين الجدولين (طبعا يجب عليك ان تغير الحقول يدويا اذا تطلب الامر) ، *** لا تلحق اي رقم الى حقل AutoNumber ، فهذا سيوقف الاستعلام ولن تعلم ما المشكلة *** في حقل Name_ID ، اذهب الى Criteria واضف: Forms!form1!form2!Name_ID واحفظ الاستعلام والآن ، في النموذج الفرعي ، انصحك : بعمل زر لكل سجل (او زر واحد في اعلى النموذج الفرعي) ، وتجعل حدث النقر يشغل الاستعلام ، او بعمب النقر المزدوج على احد الحقول ، وتعمل حدث النقر المزدوج يشغل الاستعلام . والسبب هو ، انك قد تحتاج الدخول في احد سجلات النموذج الفرعي لأي سبب ، فلا تريد ان تقيد المستخدم بعدم تمكنه من التنقل بين السجلات على كيفه ، وانما اعطه حلاً ابسط جعفر
  15. السلام عليكم . نعم ، ولكن بمراعاة ان القيم نص او ارقام : هكذا اذا كانت قيمة name نص "[name]='" & Me.mol & "'" وهكذا اذا كانت قيمة name رقم "[name]=" & Me.mol جعفر
  16. الحمدلله ولا يهمك ، ومثل ما يقول العمانيين: كل يوم تعال جعفر
  17. تفضل هذا الرابط ، أخي الكريم http://www.officena.net/ib/topic/23541-حدوث-خطأ-عند-ربط-الاكسس-بنموذج-وورد/#comment-109340 جعفر
  18. نعم ممكن قبل السطر التالي: يمكن البحث في Me.Add_List عن الاسم الجديد من Me.cmb_List قبل ادخالها في Me.Add_List ، مثلا: if instr(me.Add_List,Me.cmd_List)>0 then نعم المادة موجودة في القائمة else المادة غير موجودة في القائمة endif جعفر اما: . فيمكنك البحث في VBA عن Msgbox ، وسوف ترى مثال هناك تستطيع ان تستعمله فيما تريد جعفر
  19. وعليكم السلام . تفضل ، المرفق في هذا الرابط يقوم بفتح النموذج عدة مرات ، بدون ان يعمل نسخ جديدة: http://allenbrowne.com/ser-35.html جعفر
  20. وعليكم السلام ايش رايك اعلمك كبف تصيد ، بدل ما اعطيك السمكة يجب ان تختار صح على المربع الاحمر رقم 3 . اغلق البرنامج ، وافتحه، إما تنقر مرتين على رقم 1 او تنقر مرة على رقم 2 او تختار من القائمة جعفر
  21. وعليكم السلام . نعم انا جربته ، وناوي اعمل له عملية تفكيك علشان اوصل لمعلوماته القيمة جدا واللي ما اعرف حتى كيف اتهجّى كلماته . انا مسافر الاربعاء ان شاء الله ، وحتكون لكم وحشه . تفضل ، هذه الايقونه: . على فكرة ، التحديث الجديد جيد ، ولكن عندي معاه بعض المشاكل ، واحد الشباب ما كان يقدر يرد على المشاركات اصلا!! جعفر
  22. وعلشان اسهل لك عملاستعلامات جديدة وطرق لعملها ، عملت لك استعلام خارجي لا علاقة له بالكود ، ولكنه يأخذ شروطه من وحدة نمطية ، فبهذه الطريقة تقدر تعمل اي استعلام جديد: . وعملت تقرير على اساس هذا الاستعلام ، فاصبحت النتيجة: . والكود اصبح: Option Compare Database Option Explicit Public Add_Them As String Private Sub TreeView1_nodeClick(ByVal node As Object) On Error GoTo err_TreeView1_nodeClick Dim Pos As Integer If node.Index > 1 Then Dim tt As String tt = Split(node.Key, ";")(0) TempVars.add "Acc1", Mid(tt, 2) ' DoCmd.OpenForm "acc1", acNormal End If Pos = InStr(1, TreeView1.SelectedItem, "..") - 1 If Pos > 0 Then If Left(TreeView1.SelectedItem, Pos) = "1299999" Then ' DoCmd.OpenForm "Form1" End If End If Dim Parent_and_Children As String Dim mySQL As String Dim rst As DAO.Recordset Parent_and_Children = node.Key Add_Them = "" 'get the insert the Parent node, and ask for the Childern nodes Parent_and_Children = Add_Them & ";" & node.Key & ";" & TraverseChildren(node) 'Remove the 1st A, the the node key is something like this: A385 Parent_and_Children = Mid(Parent_and_Children, 2) 'Remove the extra ; Parent_and_Children = Replace(Parent_and_Children, ";;", ";") 'Remove the "A"s Parent_and_Children = Replace(Parent_and_Children, "A", "") The_Value = Parent_and_Children '1 'prepare the results a Criteria for the WHERE condition ' Parent_and_Children = "[Account_ID] = " & Replace(Parent_and_Children, ";", " Or [Account_ID] = ") 'Debug.Print Parent_and_Children 'do a Recordset to get the results ' mySQL = "SELECT Sum(nz([CREDIT],0)) AS C, Sum(nz([DEBIT],0)) AS D, Sum(nz([CREDIT],0)-nz([DEBIT],0)) AS B" ' mySQL = mySQL & " FROM Trans" ' mySQL = mySQL & " WHERE " & Parent_and_Children 'Debug.Print mySQL ' Set rst = CurrentDb.OpenRecordset(mySQL) ' MsgBox "Credit=" & rst!C & vbCrLf & _ "Debit=" & rst!D & vbCrLf & _ "Balance=" & rst!B 'OR '2 The_Value = Replace(The_Value, ";", ",") DoCmd.OpenReport "rpt_Sum_Children", acViewPreview Exit Sub On Error Resume Next Debug.Print "node.Child; " & node.Child Debug.Print "node.Children; " & node.Children Debug.Print "node.Expanded; " & node.Expanded Debug.Print "node.FirstSibling; " & node.FirstSibling Debug.Print "node.FullPath; " & node.FullPath Debug.Print "node.Index; " & node.Index Debug.Print "node.Key; " & node.Key Debug.Print "node.LastSibling; " & node.LastSibling Debug.Print "node.Next; " & node.Next Debug.Print "node.Parent; " & node.Parent Debug.Print "node.Previous; " & node.Previous Debug.Print "node.Root; " & node.Root Debug.Print "node.Selected; " & node.Selected Debug.Print "node.Sorted; " & node.Sorted Debug.Print "node.Tag; " & node.Tag Debug.Print "node.Text; " & node.Text Debug.Print "----------------------" err_TreeView1_nodeClick: If Err.Number = 3075 Then 'only one condition, remove the extra bits Parent_and_Children = Replace(Parent_and_Children, " Or [Account_ID] = ", "") mySQL = "SELECT Sum(nz([CREDIT],0)) AS C, Sum(nz([DEBIT],0)) AS D, Sum(nz([CREDIT],0)-nz([DEBIT],0)) AS B" mySQL = mySQL & " FROM Trans" mySQL = mySQL & " WHERE " & Parent_and_Children 'Debug.Print mySQL Set rst = CurrentDb.OpenRecordset(mySQL) Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub Function TraverseChildren(node As MSComctlLib.node) ' 'from http://www.access-programmers.co.uk/forums/showpost.php?p=589097&postcount=5 'modified by jjafferr 21-11-2015 ' ' writes the text of each child node to the debug window ' or a message if no child nodes exist Dim n As MSComctlLib.node Dim i As Integer 'using the 'Child' property of the node, get the first child Set n = node.Child 'traverse the children using the 'Children' property of the node For i = 1 To node.Children 'display the text of the child node 'Debug.Print n.Key & vbTab & n.Text Add_Them = Add_Them & ";" & n.Key 'to affect recursion, uncomment this line TraverseChildren n 'using the 'Next' property of the current child, get the next child Set n = n.Next Next i 'indicate no children If i = 0 Then Debug.Print "Node has zero children" TraverseChildren = Add_Them End Function . والوحدة النمطية التي ترسل الشروط للإستعلام: Option Compare Database Public The_Value As String Function Get_Qry_Criteria() Get_Qry_Criteria = The_Value End Function . جعفر 273.2.Tree.accdb.zip
  23. وعليكم السلام بدل name فقط "[name]='" & Me.mol & "'" تستطيع ان تضيف الشروط التي تريد ، بمراعاة ان الحقل نص او رقم او تاريخ يعني اخبرنا ماهو sss و yyyy ومن ثم نقدر نعدل لك الكود ، بس الافضل ان ترفق مرفق آخر به قيم الحقول الجديدة جعفر
×
×
  • اضف...

Important Information