jjafferr

وعليكم السلام كل رسالة خطأ ، لها رقم ، وتظهر الرسالة في اماكن مختلفة ، فاذا عرفت الحدث الذي تطلع الرسالة فيه ، وما يهمك تحل سبب الرسالة ، تستطيع ان تضع السطر التالي على السطر الثاني من الحدث: Private sub ...... on error resume next جعفر

وعليكم السلام نعم ممكن ، وذلك بعمل جدول مؤقت للطباعة ويكون مصدر التقرير medicine في النموذج Form8 ، وعند النقر على الزر "طباعة باركود" ، فيجب ان نعمل سجلات بالعدد المطلوب في الجدول المؤقت ، ثم نعطي زر الطباعة DoCmd.OpenReport "medicine" حيث ان الجدول سيحتوي على عدد السجلات المطلوبة مباشرة ، بينما نحن الان ، نطلب منه ان يطبع ، ثم يطبع ، ثم يطبع ، ثم ... جعفر

السلام عليكم أخي إسلام مادام صار عندك فضول في فهم قوة الاستعلام ، اليك هذا الرابط: http://www.officena.net/ib/topic/65067-ما-هي-طريقة-استيراد-بيانات-من-عدة-صفحات-اكسل-الى-جدول-اكسس/?do=findComment&comment=423657 جعفر

السلام عليكم . هذا صحيح ، ولكن في نهاية الدالة تستطيع تختار النطاق 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

تفضل 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 جعفر

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

عفوا الظاهر ما فهمت قصدك يعني المستخدم لازم يختار من القائمتين ، ثم يفتح التقرير؟ ويفتح التقرير على اساس الحقلين alsaf و fsl ؟ جعفر

وعليكم السلام نفترض ان الحقل Name_ID هو الحقل الذي تعتمد عليه في اختيار سجلاتك ، اعمل استعلام جديد ، واختر الجدول data1 ، غيّر الاستعلام الى استعلام الحاقي للجدول data2 ، واضف الحقول التي تريدها ، والبرنامج سيضيف الحقول المتشابهة بين الجدولين (طبعا يجب عليك ان تغير الحقول يدويا اذا تطلب الامر) ، *** لا تلحق اي رقم الى حقل AutoNumber ، فهذا سيوقف الاستعلام ولن تعلم ما المشكلة *** في حقل Name_ID ، اذهب الى Criteria واضف: Forms!form1!form2!Name_ID واحفظ الاستعلام والآن ، في النموذج الفرعي ، انصحك : بعمل زر لكل سجل (او زر واحد في اعلى النموذج الفرعي) ، وتجعل حدث النقر يشغل الاستعلام ، او بعمب النقر المزدوج على احد الحقول ، وتعمل حدث النقر المزدوج يشغل الاستعلام . والسبب هو ، انك قد تحتاج الدخول في احد سجلات النموذج الفرعي لأي سبب ، فلا تريد ان تقيد المستخدم بعدم تمكنه من التنقل بين السجلات على كيفه ، وانما اعطه حلاً ابسط جعفر

السلام عليكم . نعم ، ولكن بمراعاة ان القيم نص او ارقام : هكذا اذا كانت قيمة name نص "[name]='" & Me.mol & "'" وهكذا اذا كانت قيمة name رقم "[name]=" & Me.mol جعفر

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

تفضل هذا الرابط ، أخي الكريم http://www.officena.net/ib/topic/23541-حدوث-خطأ-عند-ربط-الاكسس-بنموذج-وورد/#comment-109340 جعفر

نعم ممكن قبل السطر التالي: يمكن البحث في Me.Add_List عن الاسم الجديد من Me.cmb_List قبل ادخالها في Me.Add_List ، مثلا: if instr(me.Add_List,Me.cmd_List)>0 then نعم المادة موجودة في القائمة else المادة غير موجودة في القائمة endif جعفر اما: . فيمكنك البحث في VBA عن Msgbox ، وسوف ترى مثال هناك تستطيع ان تستعمله فيما تريد جعفر

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

وعليكم السلام . تفضل ، المرفق في هذا الرابط يقوم بفتح النموذج عدة مرات ، بدون ان يعمل نسخ جديدة: http://allenbrowne.com/ser-35.html جعفر

وعليكم السلام ايش رايك اعلمك كبف تصيد ، بدل ما اعطيك السمكة يجب ان تختار صح على المربع الاحمر رقم 3 . اغلق البرنامج ، وافتحه، إما تنقر مرتين على رقم 1 او تنقر مرة على رقم 2 او تختار من القائمة جعفر

وعليكم السلام . نعم انا جربته ، وناوي اعمل له عملية تفكيك علشان اوصل لمعلوماته القيمة جدا واللي ما اعرف حتى كيف اتهجّى كلماته . انا مسافر الاربعاء ان شاء الله ، وحتكون لكم وحشه . تفضل ، هذه الايقونه: . على فكرة ، التحديث الجديد جيد ، ولكن عندي معاه بعض المشاكل ، واحد الشباب ما كان يقدر يرد على المشاركات اصلا!! جعفر

وعلشان اسهل لك عملاستعلامات جديدة وطرق لعملها ، عملت لك استعلام خارجي لا علاقة له بالكود ، ولكنه يأخذ شروطه من وحدة نمطية ، فبهذه الطريقة تقدر تعمل اي استعلام جديد: . وعملت تقرير على اساس هذا الاستعلام ، فاصبحت النتيجة: . والكود اصبح: 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

وعليكم السلام بدل name فقط "[name]='" & Me.mol & "'" تستطيع ان تضيف الشروط التي تريد ، بمراعاة ان الحقل نص او رقم او تاريخ يعني اخبرنا ماهو sss و yyyy ومن ثم نقدر نعدل لك الكود ، بس الافضل ان ترفق مرفق آخر به قيم الحقول الجديدة جعفر

شكرا جزيلا أخي الكريم على هذه اللفته الجميلة منك اما بالنسبة لطلبك ، فتلاحظ اننا عملنا استعلام بهذه الاسطر: 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 . وعلى اساس حاجة الاستعلام ، ذللنا Parent_and_Children وجعلنا نتيجتها تخدم الاستعلام بهذه الخطوات: '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", "") 'prepare the results a Criteria for the WHERE condition Parent_and_Children = "[Account_ID] = " & Replace(Parent_and_Children, ";", " Or [Account_ID] = ") . فنعم ، يمكنك تغيير هذا الاستعلام الى ما شئت ، وعليه يجب تغيير Parent_and_Children لتتناسب قيمه مع المطلوب جعفر

حياك الله أخوي حسين بس طلب لوسمحت تجرب وتخبرنا النتيجة: 1. مال مشاركتي الاخيرة اللي فيها Application.Echo False ، 2. وكذلك مال اخينا ابوعارف ، لأني اعرف اننا لا يمكن ان نعمل setfocus على حقل مخفي في نموذج ، فما ادري اذا ممكن نستخدم Docmd.SelectObject على تقرير مخفي جعفر

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

أخي العزيز محمد شكرا لك على تشجيعك المستمر والامتناهي ، تحية إجلال وإحترام لشخصك الكريم جعفر

السلام عليكم . ايه والله ، صار لي من امس وانا احاول فيه ، لكن الحمدلله النتيجة: والكود: 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 'Call TraverseChildren(node) 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", "") '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 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 . انا تركت لك في الكود بعض الاوامر اللي قد تفيدك في عملية الشجرة ، واعتقد بإمكانك ان تستعمل النتائج في المكان اللي تريد ، فانا عملت لك النتيجة على هيئة Recordset: Set rst = CurrentDb.OpenRecordset(mySQL) MsgBox "Credit=" & rst!C & vbCrLf & _ "Debit=" & rst!D & vbCrLf & _ "Balance=" & rst!B جعفر 273.1.Tree.accdb.zip

. رحم الله والديك ، كنت افتش على هذا الامر وما لقيته جعفر