ابوخليل

تفضل هذه الوحدة النمطية الخاصة كما في الصورة اعلاه افتح الاستعلام وانظر النتيجة : الرقم الموجب زيادة والرقم السالب نقص والصفر هو الوزن المثالي يمكنك بناء نموذجك على الاستعلام ولا حظ ان اي تغيير على الارقام سيتغير التقييم آليا يمكن ايضا ادخال الجنس ذكر / انثى ضمن الوحدة النمطية ان رغبت في ذلك سوف اضع لك الاساس وانت تدخل الاوزان Public Function GetPerfectWeight(xheight As Integer, xold As Integer) As Double If xheight = 150 Then If xold <= 24 Then GetPerfectWeight = 57 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 60 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 61 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 64 If xold >= 50 Then GetPerfectWeight = 67 End If If xheight = 152 Then If xold <= 24 Then GetPerfectWeight = 59 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 62 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 63 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 65 If xold >= 50 Then GetPerfectWeight = 68 End If If xheight = 154 Then If xold <= 24 Then GetPerfectWeight = 60 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 63 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 64 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 67 If xold >= 50 Then GetPerfectWeight = 70 End If If xheight = 156 Then If xold <= 24 Then GetPerfectWeight = 63 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 64 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 66 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 68 If xold >= 50 Then GetPerfectWeight = 72 End If If xheight = 158 Then If xold <= 24 Then GetPerfectWeight = 63 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 66 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 67 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 71 If xold >= 50 Then GetPerfectWeight = 73 End If If xheight = 160 Then If xold <= 24 Then GetPerfectWeight = 65 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 67 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 69 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 72 If xold >= 50 Then GetPerfectWeight = 75 End If If xheight = 162 Then If xold <= 24 Then GetPerfectWeight = 66 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 68 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 70 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 74 If xold >= 50 Then GetPerfectWeight = 76 End If If xheight = 164 Then If xold <= 24 Then GetPerfectWeight = 67 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 69 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 72 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 75 If xold >= 50 Then GetPerfectWeight = 77 End If If xheight = 166 Then If xold <= 24 Then GetPerfectWeight = 68 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 71 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 74 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 76 If xold >= 50 Then GetPerfectWeight = 79 End If If xheight = 168 Then If xold <= 24 Then GetPerfectWeight = 69 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 73 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 75 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 78 If xold >= 50 Then GetPerfectWeight = 80 End If If xheight = 170 Then If xold <= 24 Then GetPerfectWeight = 70 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 74 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 77 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 80 If xold >= 50 Then GetPerfectWeight = 83 End If If xheight = 172 Then If xold <= 24 Then GetPerfectWeight = 72 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 76 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 78 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 81 If xold >= 50 Then GetPerfectWeight = 85 End If If xheight = 174 Then If xold <= 24 Then GetPerfectWeight = 74 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 77 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 80 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 83 If xold >= 50 Then GetPerfectWeight = 86 End If If xheight = 176 Then If xold <= 24 Then GetPerfectWeight = 76 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 78 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 82 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 85 If xold >= 50 Then GetPerfectWeight = 88 End If If xheight = 178 Then If xold <= 24 Then GetPerfectWeight = 77 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 80 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 83 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 87 If xold >= 50 Then GetPerfectWeight = 90 End If If xheight = 180 Then If xold <= 24 Then GetPerfectWeight = 79 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 82 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 85 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 89 If xold >= 50 Then GetPerfectWeight = 92 End If If xheight = 182 Then If xold <= 24 Then GetPerfectWeight = 81 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 84 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 87 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 90 If xold >= 50 Then GetPerfectWeight = 94 End If If xheight = 184 Then If xold <= 24 Then GetPerfectWeight = 82 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 86 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 89 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 92 If xold >= 50 Then GetPerfectWeight = 96 End If If xheight = 186 Then If xold <= 24 Then GetPerfectWeight = 84 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 87 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 90 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 94 If xold >= 50 Then GetPerfectWeight = 98 End If If xheight = 188 Then If xold <= 24 Then GetPerfectWeight = 85 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 89 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 92 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 96 If xold >= 50 Then GetPerfectWeight = 100 End If If xheight = 190 Then If xold <= 24 Then GetPerfectWeight = 86 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 90 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 95 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 98 If xold >= 50 Then GetPerfectWeight = 102 End If If xheight = 192 Then If xold <= 24 Then GetPerfectWeight = 87 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 91 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 96 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 100 If xold >= 50 Then GetPerfectWeight = 104 End If If xheight = 194 Then If xold <= 24 Then GetPerfectWeight = 88 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 92 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 98 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 102 If xold >= 50 Then GetPerfectWeight = 106 End If If xheight = 196 Then If xold <= 24 Then GetPerfectWeight = 89 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 93 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 100 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 104 If xold >= 50 Then GetPerfectWeight = 108 End If If xheight = 198 Then If xold <= 24 Then GetPerfectWeight = 90 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 94 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 101 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 106 If xold >= 50 Then GetPerfectWeight = 110 End If If xheight = 200 Then If xold <= 24 Then GetPerfectWeight = 91 If xold >= 25 And xold <= 29 Then GetPerfectWeight = 95 If xold >= 30 And xold <= 39 Then GetPerfectWeight = 103 If xold >= 40 And xold <= 49 Then GetPerfectWeight = 108 If xold >= 50 Then GetPerfectWeight = 112 End If End Function الوزن المثالي2.rar

بعد التجربة رأيت من الافضل تحديد المواد المعتمدة بالادراج الجماعي ،، بدلا من وضع الشروط عملت لك نموذج لجدول النشاط من خلاله يمكنك التحكم باظهار المواد في مربع التحرير التي ينطبق عليها التعميم رصد الانشطة3.rar

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

السلام عليكم الصورة غير واضحة ، الجزء السفلي الايسر من الصورة مظلل بالسواد والاسطر السفلية لا تظهر حاول ترفق صورة اكثر جودة

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

تم تعديل الكود ليأخذ سطرا واحدا Private Sub Command138_Click() Dim i As Object, Msg$, T#, F#, U# For Each i In CreateObject("Scripting.FileSystemObject").Drives With i If .IsReady And .DriveType = 1 Then T = .TotalSize: F = .FreeSpace: U = T - F If Len(Msg) Then Msg = Msg & vbLf & vbLf Msg = .DriveLetter & ":" & " " & .VolumeName & " " Msg = Msg & "(" & .FileSystem & ")" & " " Msg = Msg & "(" & FormatSize(T) & "Tot" & ")" & " " Msg = Msg & "(" & FormatSize(F) & "free" & ")" & " " Msg = Msg & "(" & FormatSize(U) & "used" & ")" End If End With Next If Len(Msg) Then coDesks.AddItem Msg End Sub وهذه وحدة نمطية لارجاع حجم الرقم او ما يسمى السعة Public Function FormatSize(ByVal Size As Currency) As String Const Kilobyte As Currency = 1024@ Const TenK As Currency = 10240@ Const HundredK As Currency = 102400@ Const ThousandK As Currency = 1024000@ Const Megabyte As Currency = 1048576@ Const TenMeg As Currency = 10485760@ Const HundredMeg As Currency = 104857600@ Const ThousandMeg As Currency = 1048576000@ Const Gigabyte As Currency = 1073741824@ Const TenGig As Currency = 10737418240@ Const HundredGig As Currency = 107374182400@ Const ThousandGig As Currency = 1073741824000@ Const Terabyte As Currency = 1099511627776@ Select Case Size Case Is < Kilobyte: FormatSize = Int(Size) & " bytes" Case Is < TenK: FormatSize = Format(Size / Kilobyte, "0.00") & " KB" Case Is < HundredK: FormatSize = Format(Size / Kilobyte, "0.0") & " KB" Case Is < ThousandK: FormatSize = Int(Size / Kilobyte) & " KB" Case Is < TenMeg: FormatSize = Format(Size / Megabyte, "0.00") & " MB" Case Is < HundredMeg: FormatSize = Format(Size / Megabyte, "0.0") & " MB" Case Is < ThousandMeg: FormatSize = Int(Size / Megabyte) & " MB" Case Is < TenGig: FormatSize = Format(Size / Gigabyte, "0.00") & " GB" Case Is < HundredGig: FormatSize = Format(Size / Gigabyte, "0.0") & " GB" Case Is < ThousandGig: FormatSize = Int(Size / Gigabyte) & " GB" Case Else: FormatSize = Format(Size / Terabyte, "0.00") & " TB" End Select End Function Database4.rar

تفضل .. منقول ... Const MB& = 1048576 Dim i As Object, Msg$, T#, F#, U# For Each i In CreateObject("Scripting.FileSystemObject").drives With i If .IsReady And .DriveType = 1 Then T = .TotalSize / MB: F = .FreeSpace / MB: U = T - F If Len(Msg) Then Msg = Msg & vbLf & vbLf Msg = "Drive " & .DriveLetter & ":" & vbTab Msg = Msg & .VolumeName & " (" & .FileSystem & ")" Msg = Msg & vbLf & "Total size:" & vbTab Msg = Msg & Format(T, "#,##0 MB") & vbLf Msg = Msg & "Free space:" & vbTab Msg = Msg & Format(F, "#,##0 MB") & vbLf Msg = Msg & "Used space:" & vbTab Msg = Msg & Format(U, "#,##0 MB") End If End With Next If Len(Msg) Then MsgBox Msg

Dim i As Integer, R As Integer Dim rs As Recordset Dim x As String Set rs = Me.RecordsetClone rs.MoveLast R = rs.RecordCount rs.MoveFirst x = txt_nshat For i = 1 To R rs.Edit rs.Fields(x) = drga2 rs.Update rs.MoveNext Next غفلت عن تعديل آخر سطر MsgBox ("تم رصد نشاط") & " ( " & Me.txt_nshat & " ) " بدله بهذا MsgBox ("تم رصد نشاط") & " ( " & Me.txt_nshat.Column(1) & " ) " التعديل الذي تم انظر في جدول tb_nshat وانظر في مصدر بيانات مربع التحرير رصد الانشطة2.rar

عليكم السلام وجدت هذا الكود وقمت بالتعديل عليه بحيث يظهر الاقراص الخارجية في قائمة وفي القائمة الاخرى يظهر جميع الأقراص وتم تطبيقه على المرفق ادناه Dim vl As Scripting.FileSystemObject Dim Drv As Scripting.Drive Set vl = New Scripting.FileSystemObject For Each Drv In vl.Drives coDesks.AddItem Drv.DriveLetter If Drv.DriveType = Removable Then coDesks2.AddItem Drv.DriveLetter End If Next Drv عند نقلك الكود الى برنامجك لا تنسى اضافة المكتبة الخاصة ... اطلع عليها في المثال deskDb.rar

وجدت لك هذا المرفق يشتمل على بعض الجداول الاساسية ، اعجبني التصميم لعلك تستفيد منه account.mdb

كأني رأيت المرفق من قبل تفضل تم اضافة زر للنسخ تأكد اولا من اعدادات مكان القاعدة ومكان النسخة MS_LOGO2.rar

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

عندي يعمل جهازي وندوز 7 اوفيس 10 /32 بت

مرحبا بك في منتدى اوفيسنا 1- اعمل جدول بالبيانات الاساسية الثابتة غير المتغيرة م / رقم العميل / اسم العميل / العنوان / الهاتف ...... الخ 2- اعمل جدولا آخر لتفاصيل العمليات اعتقد انت بحاجة الى حقل واحد فقط يشمل جميع الحقول .. مافيه شي اسمه مرحل ولا جديد حقل واحد للقيمة المدفوعة وحقل بجانبه للبيان فقط من اجل كتابة مبلغ اول المدة الرصيد يظهر في الاستعلام وليس في الجدول

وجدت لك هذه وحدة نمطية عامة اجعلها في مديول #If VBA7 Then Private Declare PtrSafe Function GetShortPathName Lib "kernel32" _ Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _ ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long #Else Private Declare Function GetShortPathName Lib "kernel32" _ Alias "GetShortPathNameA" (ByVal lpszLongPath As String, _ ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long #End If Public Function GetShortName(ByVal sLongFileName As String) As String Dim lRetVal As Long, sShortPathName As String, iLen As Integer 'Set up buffer area for API function call return sShortPathName = Space(255) iLen = Len(sShortPathName) 'Call the function lRetVal = GetShortPathName(sLongFileName, sShortPathName, iLen) 'Strip away unwanted characters. GetShortName = Left(sShortPathName, lRetVal) End Function ويتم مناداتها بهذا السطر Shell ("cmd /c mspaint /p " & GetShortName(CurrentProject.path & "\" & Me.picFld & ".jpg"))

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

نسيت ان اذكر يجب تفعيل خانة تتالي الحذف في العلاقة ، من اجل تكتفي بحذف الجدول الرئيس

اذا تكتفي بسطر الاستاذ قاسم هذا Set rsFatora = db.OpenRecordset("SELECT * FROM tblFatora WHERE FatoraId <> " & strInvoiceID & "") ليصبح الكود Sub DeleteRecordsExceptOne() Dim db As DAO.Database Dim rsFatora As DAO.Recordset Dim strInvoiceID As Integer strInvoiceID = "1001" Set db = CurrentDb Set rsFatora = db.OpenRecordset("SELECT * FROM tblFatora WHERE FatoraId <> " & strInvoiceID & "") Do While Not rsFatora.EOF rsFatora.Delete rsFatora.MoveNext Loop rsFatora.Close db.Close Set rsFatora = Nothing Set db = Nothing End Sub وغير الرقم 1001 لما هو موجود عندك في الجدول الرئيس

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

اولا مربع التحرير ياخذ اسم الدائرة من الجدول الجديد ، ولكن قيمته رقم الدائرة وليس الاسم (نقدر نختار قيمة الحقل من الخصائص) 1 او 2 اي العمود الاول في الاستعلام او العمود الثاني بعد ذلك ياتي دور الكود هذا ياخذ رقم التصنيف من رقم الملف ويضعه في حقل رقم التصنيف [رقم التصنيف] = Mid([رقم الملف بالاستئناف], 5, 4) وهذا يظهر رقم الدائرة بناء على رقم التصنيف (لكن اللي يظهر امامك في مربع التحرير هو الاسم ) لاننا في الخصائص اخفينا الرقم واعطينا الاولوية للظهور للاسم [الدائرة] = [رقم التصنيف] وهذا ياخذ اسم الدائرة من مربع التحرير ويضعه في الحقل الجديد المخفي .. لاحظ الرقم 1 يعني العمود الثاني اللي هو عمود الاسم dayrh = [الدائرة].Column(1)

انظر المصدر هنا hard disk2.rar

يعني الاثنين جميعا في ترقيم واحد ؟؟؟؟ هذا الكود الأول 'لو اردت خانة الرقم تصبح 4 اصفار طبق التعليقات التي امام الاسطر Dim xLast, xNext As Integer Dim i, t, tt, x As Integer t = Format(Date, "yy") tt = Format(DMax("PatientID", "tblPatients"), "yy") i = Format(Me.p_Date, "mmyy") xLast = Right(DMax("PatientID", "tblPatients", tt = t), 3) ' يصبح الرقم 4 بدلا من 3 If IsNull(xLast) Then xNext = 1 Else xNext = xLast + 1 End If Me.PatientID = i & "/" & Format(xNext, "000") 'وهنا تزود صفر على الثلاث اصفار غير "yy" الى "mmyy" في الموضعين ليصبح الكود هكذا Private Sub p_Date_AfterUpdate() Dim xLast, xNext As Integer Dim i, t, tt, x As Integer t = Format(Date, "mmyy") tt = Format(DMax("PatientID", "tblPatients"), "mmyy") i = Format(Me.p_Date, "mmyy") xLast = Right(DMax("PatientID", "tblPatients", tt = t), 3) If IsNull(xLast) Then xNext = 1 Else xNext = xLast + 1 End If Me.PatientID = i & "/" & Format(xNext, "000") End Sub

تفضل جعلت حقل الدائرة للعرض فقط .. وعملت لك بجانبه حقل مخفي يأخذ اسم الدائرة جرب ووافني بالنتيجة وقبل كل هذا .. اذا انت ناوي تتعلم اكسس فلا بد ان تتبع القواعد الصحيحة من البداية مثلا تجنب تسمية الحقول والكائنات بحروف عربية .. اذا ما تعرف معانيها بالانجلش اكتبها بحروف لاتينية وبمعنى عربي .. ويكفي ان تكتب التسمية التوضيحية بالعربي لن تتعلم ولن تفهم الجمل البرمجية والاكواد .. لان الاكواد ستنقلب رأسا على عقب واكبر خبير لا يمكنه فهمها ( لانه يجتمع في الكود حروف عربية واخرى انجليزية ) قاعدة تجريبية3.rar

انظر في المرفق ادخل رقم الملف ثم انتر وانظر ماذا يحدث في حقل التصنيف وفي حقل الدائرة ... وارجع الى الجدول لترى ايضا عملت لك جدول بارقام التصنيفات والدوائر .. راجعه وصححه واكمل ما تبقى على النسق نفسه قاعدة تجريبية2.rar

ههههه بعد شرح المعنى عرفت انطق الاولى لانها مشتركة بيننا وبينهم ، لاني في الأول قرأتها بتشديد الواو مع الكسر وفتح الدال ثم تاء مربوطة ( مؤنث دودة ) على وزن متفعٍلَة والنطق الصحيح بها بتسكين الواو مع كسر خفيف للدال الثانية ثم هاء .. مْتدُوْدِه حتى الميم تسكن وكأنك تنطق m اما الكلمة الثانية فلا نشترك فيها معهم الله يسعدك