نجوم المشاركات

حيالله السيد جمال 🙂 تفضل اخي سمير ، اعددت لك هذا البرنامج ، لكل اصدارات الاكسس 🙂 اختار البرنامج الذي تريد تعرف من يعمل عليه ، ثم اضغط على الزر who is logged جعفر Who is logged in.zip

وعليكم السلام ابو ياسين 🙂 اقترح عليك ان تضع كل 5 حقول في سطر واحد (مثلا) ، ثم تعطي كل سطر رقم تسلسل (لاحظ الصورة المرفقة) : Dim mySQL As String '1 mySQL = " INSERT INTO Data4" mySQL = mySQL & " ( rakm, name, daftar, nofatora, [user], " '1 mySQL = mySQL & " [date], sar, madfoa, taslim, datew, " '2 mySQL = mySQL & " bage, kasm, tob, taslim2, date2, " '3 mySQL = mySQL & " komash, quntt, komash1, quntt1, komash2, " '4 mySQL = mySQL & " quntt2, komash3, quntt3, komash4, quntt4, " '5 mySQL = mySQL & " komash5, quntt5, komash6, quntt6, komash7, " '6 mySQL = mySQL & " quntt7, molhda, oakt, goal, " '7 mySQL = mySQL & " الطول, الكتف, [طول اليد], الرقبة, الوسع, " '8 mySQL = mySQL & " [وسع اليد], [وسع اليد1], [وسع اليد 2], [طقطق مع زر], [الوسع الاسفل], " '9 mySQL = mySQL & " [كفه اسفل], حشوه, جيبزور, يد, جيب, " '10 mySQL = mySQL & " [رقبة قلاب], [رقبة سادة], خياطه, [جيب جوال], [الثوب كامل دقتين], " '11 mySQL = mySQL & " تطريز, زرار, ملاحظات, ملون, " '12 mySQL = mySQL & " astalim, notaslem, astalim2, date3, kiyat, " '13 mySQL = mySQL & " date4, x1, 1, 2, 3, " '14 mySQL = mySQL & " 4, 5, 6, 7, 8, " '15 mySQL = mySQL & " 9, 10, 11, 12, 13, " '16 mySQL = mySQL & " 14, 15, 16, 17, 18, " '17 mySQL = mySQL & " 19, 20, 21, 22, 23, " '18 mySQL = mySQL & " 24, 25, 26, 27, 28, " '19 mySQL = mySQL & " 29, 30, 31, 32, 33, " '20 mySQL = mySQL & " 34, 35, 36, 37, 38, " '21 mySQL = mySQL & " 39, 40, 41, 42, 43, " '22 mySQL = mySQL & " 44, 45, 46, 47, 48, " '23 mySQL = mySQL & " 49, 50, 51, 52, 53, " '24 mySQL = mySQL & " 54, 55, 56, 57, " '25 mySQL = mySQL & " نص1, نص2, نص3, نص4, نص5, " '26 mySQL = mySQL & " نص6, نص7, نص8, نص9, نص10, " '27 mySQL = mySQL & " نص11, نص12, نص13, نص14, نص15, " '28 mySQL = mySQL & " نص16, نص17, sora, date5, " '29 mySQL = mySQL & " رقم_القماش, رقم_القماش1, رقم_القماش2, رقم_القماش3, رقم_القماش4, " '30 mySQL = mySQL & " رقم_القماش5, رقم_القماش6, رقم_القماش7, daraba )" '31 '2 mySQL = mySQL & " SELECT " mySQL = mySQL & " rakm, name, daftar, nofatora, User, " '1 mySQL = mySQL & " Date, sar, madfoa, taslim, datew, " '2 mySQL = mySQL & " bage, kasm, tob, taslim2, date2, " '3 mySQL = mySQL & " komash, quntt, komash1, quntt1, komash2, " '4 mySQL = mySQL & " quntt2, komash3, quntt3, komash4, quntt4, " '5 mySQL = mySQL & " komash5, quntt5, komash6, quntt6, komash7, " '6 mySQL = mySQL & " quntt7, molhda, oakt, goal, " '7 mySQL = mySQL & " الطول, الكتف, [طول اليد], الرقبة, الوسع, [وسع اليد], " mySQL = mySQL & " [وسع اليد1], [وسع اليد 2], [طقطق مع زر], [الوسع الاسفل], " mySQL = mySQL & " [كفه اسفل], حشوه, جيبزور, يد, جيب, [رقبة قلاب], [رقبة سادة], خياطه, " mySQL = mySQL & " [جيب جوال], [الثوب كامل دقتين], تطريز, زرار, ملاحظات, ملون, " mySQL = mySQL & " astalim, notaslem, astalim2, date3, kiyat, date4, x1, " mySQL = mySQL & " [1], [2], [3], [4], [5], [6], [7], [8], [9], [10], [11], [12], [13], [1], " mySQL = mySQL & " [15], [16], [17], [18], [19], [20], [21], [22], " mySQL = mySQL & " [23], [24], [25], [26], [27], [28], [29], [30], " mySQL = mySQL & " [31], [32], [33], [34], [35], [36], [37], [38], " mySQL = mySQL & " [39], [40], [41], [42], [43], [44], [45], [46], " mySQL = mySQL & " [47], [48], [49], [50], [51], [52], [53], [54], [55], [56], [57], " mySQL = mySQL & " نص1, نص2, نص3, نص4, نص5, نص6, نص7, نص8, نص9, " mySQL = mySQL & " نص10, نص11, نص12, نص13, نص14, نص15, نص16, نص17, " mySQL = mySQL & " sora, date5, " mySQL = mySQL & " رقم_القماش, رقم_القماش1, رقم_القماش2, رقم_القماش3, " mySQL = mySQL & " رقم_القماش4, رقم_القماش5, رقم_القماش6, رقم_القماش7, daraba " mySQL = mySQL & " from Data" mySQL = mySQL & " WHERE nofatora=" & [Forms]![Data]![رقم الفاتورة2] DoCmd.RunSQL mySQL . اذا تلاحظ الخطين الاحمرين ، بحيث كل رقم من الاعلى ، له رقمه في الاسفل ، وهي نفس الحقول التي تُدرج فيه البيانات ، وبهذه الطريقة المنظمة ، يمكنك اكتشاف الاخطاء : . جعفر

هممم انت قلت والآن تقول لتسهيل العمل ، اقترح عليك عمل حقل جديد في جدول constants باسم use_this_school ومن نوع Yes/No . بحيث تختار سجل المدرسة الصحيحة مرة واحدة ، او مرة كل سنة ، وعليه نعمل الاستعلام qry_constant للجدول constant ، ونضع معيار لهذا الحقل الجديد ، ثم يكون هذا الاستعلام مصدر بيانات النموذج: . اما بالنسبة الى التقرير ، فاقترح ان تعمل تقرير فرعي للمنطقة الحمراء في الصورة ادناه ، بالبيانات المطلوبة ، ويكون مصدرها الاستعلام qry_constant . جعفر 996.2.حوسبة العمل الاداري 1.0.mdb.zip

وعليكم السلام ورحمة الله وبركاته 🙂 معظم الاعضاء يقرأون السؤال، وعلى اثره يرون مقدرتهم على الاجابة على السؤال، اما اذا يتطلب الموضوع ان انزل المرفق لأعرف السؤال، فـ 99.9% من الوقت ، انا لا انزل المرفق، وانتقل للموضوع التالي والآن نرجع الى سؤالك: بما انه لا يمكننا التأكد من نتائج برنامجك ، لأنه مربوط بميزان ، لذلك من الصعب الاجابة على السؤال !! لذلك، فالنجعل البرنامج يخبرنا بما يراه، وعليه نرى الطريقة الاصح لضبط الجواب 🙂 استعمل هذا الكود بدل الكود الذي ارفقته (هو نفس كودك، ولكن بتنسيق، وبه اوامر طباعة النتائج الى ملف MSComm_Listening.txt في نفس مجلد برنامجك) : Private Sub MSComm1_OnComm() On Error Resume Next Dim c As Variant Dim n As Integer Dim File_Path As String File_Path = Application.CurrentProject.Path & "\MSComm_Listening.txt" Open File_Path For Output As #1 If MSComm1.CommEvent = comEvReceive Then If comEvEOF Then MSComm1.InputLen = 1 Do While MSComm1.Input = "0" MSComm1.InputLen = 8 c = MSComm1.Input c1 = "" Print #1, "Do c=" & c & vbTab & "len(c)=" & Len(c) Print #1, For i = 1 To Len(c) cut = Mid(c, i, 1) Print #1, "For cut=" & cut If (IsNumeric(cut)) Or (cut = ".") Then Print #1, "Old c1=" & c1 c1 = c1 & cut Print #1, "New c1=" & c1 End If Next i Print #1, Label5.Caption = Val(c1) Print #1, "Val(c1) =" & Val(c1) Loop End If 'comEvEOF End If 'MSComm1 MSComm1.InBufferCount = 0 Close #1 End Sub . ثم قم بعمل الوزن بالطريقة الطبيعية ، ثم ارفق لنا ملف MSComm_Listening.txt ، واخبرنا كم يجب ان تكون النتيجة الصحيحة 🙂 جعفر

البرنامج يعطيك اسم المستخد واسم الكمبيوتر. ويمكنك عمل جدول فيه ارقام الكمبيوترات واسم كل مستخدم ، ثم عند استعمال البرنامج ، استعمل الاسماء من الجدول بواسطة Dlookup مثلا. جعفر

تم عمل تعديل طفيف على البرنامج اعلاه ، ويعمل لجميع اصدارات الاكسس 🙂 وهناك برنامج جاهز (غير مجاني) يعمل اللي تريده واكثر: https://www.fmsinc.com/microsoftaccess/monitor.asp جعفر

جزاك الله خيرا عمل جميل لو تسمح لدى بعض المقترحات لاثراء الموضوع: 1- لو تم اضافة تاريخ عقد المستأجر - وتنبيه بقرب انتهاء العقود 2- اخر تاريخ سداد للمستأجر وحساب الايجارات المتأخرة عليه

شكرا اخي و استادي سليم سوف اجرب ماشاء الله ولمن لما لا تضهراسماء الزبائن

مشكور اخي سليم حاصبيا ادامك الله

السلام عليكم ورحمة الله الرجاء استبدال كود السرى بهذا الكود Sub SecNim() Dim R As Integer, S As Integer Application.ScreenUpdating = False Sheet4.Range("J8:J1000").ClearContents z = 0 For S = 7 To 16 For R = 8 To Sheet4.Range("C" & Rows.Count).End(xlUp).Row If Sheet4.Cells(R, "B") >= Cells(S, "E") And Sheet4.Cells(R, "B") <= Cells(S, "F") Then z = z + 1 Sheet4.Cells(R, "J") = Cells(S, "G") + z - 1 End If Next z = 0 Next Application.ScreenUpdating = True End Sub

بارك الله فيك اخى الكريم ولكن البرنامج لم يعمل معى ولم يفتح نهائيا

احسنت استاذى الكريم بارك الله فيك

هذا ما تم عمله تعديل في الكود فاصبح هكذا وتعديل في تصميم الحقول اللي في الصورة Set db = CurrentDb Set Td = db.TableDefs(Me.ChooseTble) Me.ChooseField.RowSource = "" Me.ChooseField.AddItem ("اسماء الحقول") For Each fld In Td.Fields On Error Resume Next sCaption = fld.Properties("Caption") If fld.Type = 4 And fld.Attributes = 17 Then Me.ChooseField.AddItem fld.Name & ";" & sCaption Else Me.ChooseField.AddItem fld.Name & ";" & sCaption End If Next

بعد اذن اخي jjafferr اظن اني فهمت الاخ زياد الحسناوي اتفضل شوف اظن انه طلبك حسب ما فهمت وهذا مع عنوان العمود final.rar

بعد اذن اخي jjafferr اظن اني فهمت الاخ زياد الحسناوي اتفضل شوف اظن انه طلبك حسب ما فهمت اكسل.rar وهذا بالطريقه الاخرى final.rar

مع انك لم ترفع ملفاً للمعاينة اليك هذا النموذج Ramadan.xlsx

الله يجزيك الخير هذا ما ابحث عنه

يمكنك وضع هذا الكود فى حدث الصفحة Sub worksheet_change(ByVal target As Range) Set target = Range("A1") If target.Value = "Delete" Then Call Macro1 End If If target.Value = "Insert" Then Call Macro2 End If End Sub او هذا Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Cells.Count > 1 Then Exit Sub If IsNumeric(Target) And Target.Address = "$A$1" Then Select Case Target.Value Case 10 To 50: Macro1 Case Is > 50: Macro2 End Select End If End Sub

الموقع المذكور لا يفتح لو لم يكن طلبك يتعلق بتهكير حسابات الغير فطلبك سهل باذن الله

اذن اخي من الاحسن ان تستعمل هذ الكود الذي طرحته في مشاركة سابقة Private Sub Worksheet_Selectionchange(ByVal Target As Range) If Target.HasFormula = True Then ActiveCell.Offset(0, 1).Select ElseIf Target.MergeCells = True And Target.HasFormula = True Then Target.Offset(0, 1).Select ElseIf ActiveCell.HasFormula = True And ActiveCell.MergeCells = True Then ActiveCell.Offset(0, 1).Select End If End Sub