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

تفضل هذه الطريقة Dim db As DAO.Database Dim rs As DAO.Recordset '============== الطلاب ================= Dim MaleTrue As Integer 'الطالاب الناجحون Dim MaleFalse As Integer 'الطلاب الغير ناجخون '============== الطالبات ================= Dim FemaleTrue As Integer 'الطالبات الناجحات Dim FemaleFalse As Integer 'الطالبات الغير ناجحات Set rs = CurrentDb.OpenRecordset("Table1") ' جدول البيانات If Not rs.BOF And Not rs.EOF Then rs.MoveFirst While (Not rs.EOF) rs.Edit If rs.Fields("نوع الطالب") = "ذكر" And rs.Fields("نتيجة الطالب") = "ناجح" Then MaleTrue = MaleTrue + 1 rs![رقم الطالب] = MaleTrue ElseIf rs.Fields("نوع الطالب") = "ذكر" And rs.Fields("نتيجة الطالب") = "راسب" Then MaleFalse = MaleFalse + 1 rs.[رقم الطالب] = MaleFalse ElseIf rs.Fields("نوع الطالب") = "انثى" And rs.Fields("نتيجة الطالب") = "ناجح" Then FemaleTrue = FemaleTrue + 1 rs![رقم الطالب] = FemaleTrue ElseIf rs.Fields("نوع الطالب") = "انثى" And rs.Fields("نتيجة الطالب") = "ناجح" Then FemaleFalse = FemaleFalse + 1 rs![رقم الطالب] = FemaleFalse End If rs.Update rs.MoveNext Wend End If rs.Close Set rs = Nothing

تستطيع التحكم بحجم العنصر برمجيا بكل سهولة من خلال الكود التالي Me.TextBox1.Move(Left,Top,Widh,Height) اقترح عليك ان يتم تضمينها بشرط If Len([TextBox1]) >10 then Me.TextBox1.Move "", "" , 10 * 200 ,"" End if مع ملاحظة أن سوف تتعامل مع العمود و ليس السطر

محتمل ذلك جرب هذا التعديل 4NewData.zip

هذه الصورة بصيغة Gif ، في النموذج ، ، في وضع التصميم ، استخدم عنصر الانترنت Microsoft Web Browser : . . . وفي حدث عند تحميل النموذج: Private Sub Form_Load() Me.ocxWebBrowser.Object.Navigate CurrentProject.Path & "\Blooming_Flower.gif" End Sub . ويجب ان تكنو مختار هذه المكتبة في صفحة الكود VBE : واذا كان نظام كمبيوترك 32 بت ، فيجب ان: انقر على ...Browse ، ثم C:\Windows\System32 ، واختار الملف ieFrame.dll . والنتيجة : جعفر

يوم محدد حساب محدد عميل محدد مستند محدد

تفضل هذا التعديل بالنسبة للحذف لو تدقق في جدول الصلاحيات راح تجد عندك عدد 2 أمر للحذف ازرار الحذف صلاحية الحذف 2NewData.zip

اتفضل هذا التعديل - يجب ترحيل البيانات بعد الاستيراد بالنسبة لتحرير القيود من الشاشة الرئيسية تستطيع التحرير و لكن يجب اعطاء الصلاحية من خلال شاشة الإعدادات ايش تسفيد من هذا الإجراء لكن فيه طريقة افضل انك تنشئ جدول حفظ بيانات الدخول و تربطه بنموذج تسجيل الدخول و تضع ازرار حفظ بيانات الدخول دائن4.zip لأنك لم تقم بترحيل البيانات المستوردة هذا التعديل دائن4.zip

تفضل يا سيدي 🙂 . وهذا الجزء من الكود الذي تم تعديله: Me.FilterOn = True Me.Filter = "[yer] = " & MyYear & " and [num] ='" & MyNumnf & "' and [nu] ='" & MyMntj & "' and [NameEmb] ='" & MyMonth & "' and [jh] ='" & MyNoa & "'" ' يتم حساب عدد الحقول التي بها أرقام For i = 1 To 74 fld_value = DSum("fld" & i, "tbl", "[yer] = " & MyYear & " and [num] ='" & MyNumnf & "' and [nu] ='" & MyMntj & "' and [NameEmb] ='" & MyMonth & "' and [jh] ='" & MyNoa & "'") If fld_value > 0 Then 'Debug.Print fld_value 'If DSum("fld" & i, "tbl", "[Name1]='" & Myfilter & "'") > 0 Then flCnt = 1 + flCnt 'إظهار الحقول غير الفارغة Me("fld" & i & "").visible = True Me("lbl" & i & "").visible = True Me("s" & i & "").visible = True ' حساب عرض كل حقل Me("fld" & i & "").Width = Len(CStr(fld_value)) * 145.5 Me("LBL" & i & "").Width = Len(CStr(fld_value)) * 145.5 Me("s" & i & "").Width = Len(CStr(fld_value)) * 145.5 End If Next i If flCnt = 0 Then MsgBox "لا توجد حقول بها قيمة", , "خطأ" DoCmd.CancelEvent Exit Sub End If ' حساب عرض كل حقل 'For i = 1 To 74 'Me("fld" & i & "").Width = Me.Name1.Left / flCnt 'Me("LBL" & i & "").Width = Me.Name1.Left / flCnt 'Me("s" & i & "").Width = Me.Name1.Left / flCnt 'Next i ' إعادة توزيع الحقول غير الفارغة For i = 74 To 1 Step -1 Me("fld" & i & "").Left = WidthFld Me("lbl" & i & "").Left = WidthFld Me("s" & i & "").Left = WidthFld If Me("fld" & i & "").visible Then 'WidthFld = Me("fld" & i & "").Width + WidthFld WidthFld = Me("s" & i & "").Width + WidthFld End If Next i جعفر مطابقة موجودات2.zip

قمت بعمل تطبيق صغير لكي يقوم بعمل هووك ( فلترة ) لزر الويندوز عندما تقوم بتشغيل التطبيق سيتعطل الزر، وعند اطفاءه سيرجع الزر لعمله. HookWindowsKey.rar

جزاك الله خيرا وزادتكم الله شأنا وعلماً رفعك الله ورضى الله عنك تمام العمل 100 %

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

اخي عبدالله كللامك مظبوط يوجد خطاء تم تعديله و كان الخطاء في الحلقة الدائرية للتاكد من خلو الخلية الهدف من اي بيانات للكتابه بها سامحنا ... كل ابن آدم خطاء البرنامج.xlsm

طيب اراجعه ان شاء الله

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

شوف كيف عندي بالتاريخ ////// بالحساب ///// بالعميل //// بالمستند //// فيه ملحوظة مهمة يابو الحسن فلاتر البحث تنفذ بالأولية اذا الحساب فارغ سيتم تجاوزه و سيتم تنفيذ الكود فقط على الحقول الغير فارغة

اعطيني نسخة من القاعدة الي عندك

لأنه يستخدم API حساب تجاري مدفوع لكن انتظرني لأني ما زلت اعمل علي تصميم سهل بدون الحاجة لتثبيت تطبيق الواتس مثلما شرحت لك في الأعلى كما يوجد العدد من مزودي الخدمة معتمدين لدى فيس بوكwhatsappAPI

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

اخي الكريم، في الأكسس لا اعتقد ذلك.. لكن يمكنك ذلك في لغة VB.NET تفضل هذا هووك يقوم بهذا الغرض Imports System.Runtime.InteropServices Partial Public Class keyevent Private Structure KBDLLHOOKSTRUCT Public vkCode As Integer Private scanCode As Integer Public flags As Integer Private time As Integer Private dwExtraInfo As Integer End Structure Private Delegate Function LowLevelKeyboardProcDelegate(ByVal nCode As Integer, ByVal wParam As Integer, ByRef lParam As KBDLLHOOKSTRUCT) As Integer <DllImport("user32.dll")> Private Shared Function SetWindowsHookEx(ByVal idHook As Integer, ByVal lpfn As LowLevelKeyboardProcDelegate, ByVal hMod As IntPtr, ByVal dwThreadId As Integer) As IntPtr End Function <DllImport("user32.dll")> Private Shared Function UnhookWindowsHookEx(ByVal hHook As IntPtr) As Boolean End Function <DllImport("user32.dll")> Private Shared Function CallNextHookEx(ByVal hHook As Integer, ByVal nCode As Integer, ByVal wParam As Integer, ByRef lParam As KBDLLHOOKSTRUCT) As Integer End Function <DllImport("kernel32.dll")> Private Shared Function GetModuleHandle(ByVal path As IntPtr) As IntPtr End Function Private hHook As IntPtr Private hookProc As LowLevelKeyboardProcDelegate Const WH_KEYBOARD_LL As Integer = 13 Public Sub New() InitializeComponent() Dim hModule As IntPtr = GetModuleHandle(IntPtr.Zero) hookProc = New LowLevelKeyboardProcDelegate(AddressOf LowLevelKeyboardProc) hHook = SetWindowsHookEx(WH_KEYBOARD_LL, hookProc, hModule, 0) If hHook = IntPtr.Zero Then MessageBox.Show("Failed to set hook, error = " & Marshal.GetLastWin32Error()) End If End Sub Private Shared Function LowLevelKeyboardProc(ByVal nCode As Integer, ByVal wParam As Integer, ByRef lParam As KBDLLHOOKSTRUCT) As Integer If nCode >= 0 Then Select Case wParam Case 256 'WM_KEYDOWN If (lParam.vkCode = &H9 AndAlso lParam.flags = 32) OrElse (lParam.vkCode = &H1B AndAlso lParam.flags = 32) OrElse (lParam.vkCode = &H73 AndAlso lParam.flags = 32) OrElse (lParam.vkCode = &H1B AndAlso lParam.flags = 0) OrElse (lParam.vkCode = &H5B AndAlso lParam.flags = 1) OrElse (lParam.vkCode = &H5C AndAlso lParam.flags = 1) Then Return 1 End If End Select End If Return CallNextHookEx(0, nCode, wParam, lParam) End Function Private Sub Window_Closed(ByVal sender As Object, ByVal e As EventArgs) Handles MyBase.FormClosed UnhookWindowsHookEx(hHook) End Sub End Class

بالاضافة الى ما تفضل به اخي واستاذي الفاضل @د.كاف يار وله جزيل الشكر وحسب ما فهمت من الشرح تفضل اخي الكريم Option Compare Database Option Explicit Private Sub Command0_Click() CurrentDb.Execute "UPDATE Table1 SET group_no = Null" CurrentDb.Execute "UPDATE Table1 SET SN = Null" Dim mySQL As String Dim rst As Recordset, rs As Recordset Dim i As Integer, k As Integer, L As Integer 1 On Error GoTo 2 mySQL = "Select * From Table1 ORDER BY stu_case, stu_sex,stu_name " ' Debug.Print mySQL Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst For i = 1 To rst.RecordCount rst.Edit rst!SN = i rst.Update rst.MoveNext Next rst.Close: Set rst = Nothing 2 On Error GoTo Err mySQL = "Select * From Table1 WHERE stu_case = 1 ORDER BY stu_case, stu_sex,stu_name " ' Debug.Print mySQL Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst For i = 1 To rst.RecordCount For k = 1 To 6 rst.Edit rst!group_no = i rst.Update rst.MoveNext Next Next rst.Close: Set rst = Nothing Call randx Err: Call randx End Sub Sub randx() Dim mySQL As String Dim rst As Recordset, rs As Recordset Dim i As Integer, k As Integer, L As Integer 3 On Error GoTo Err mySQL = "Select * From Table1 WHERE stu_case = 2 ORDER BY SN " ' Debug.Print mySQL Set rst = CurrentDb.OpenRecordset(mySQL) rst.MoveLast: rst.MoveFirst L = Nz(DMax("[group_no]", "Table1"), 0) + 1 For i = L To rst.RecordCount For k = 1 To 6 rst.Edit rst!group_no = i rst.Update rst.MoveNext Next Next rst.Close: Set rst = Nothing MsgBox "Done", vbInformation, "Officena" Err: End Sub ترقيم1.mdb تحياتي

انا في رأي من خلال تطبيق مبادئ المرونه لمده عام تقريباً وعلى مشاريع وعمليات متنوعه اعتقد ان افضل تعريف هو المرونه المتصاعدة والمتكيفه

أهلابك قمت بمعالجة الخطأ.. MusndWZwayid 9.accdb

اعذرني أخي الكريم فالملف المرفق من حضرتك يعتمد على فكرة هي: ترتيب عمود تاريخ الميلاد من الأصغر للأكبر ثم البحث في الأسماء حسب تاريخ الميلاد الحالي وقد وجدت هذه الأخطاء وتم بفضل الله تصحيحها: خطأ في المسلسل عند الصف 106 تشغيل معادلة التاريخ في العمود D وضبط تنسيق التاريخ في العمود M المعادلة في البداية تقرأ حتى الصف 900 ولكن من الصف 19 أصبحت تقرأ حتى الصف 500 تم ضبط معادلة الاسم العمود Q والعمود R يقرأ حتى 500 والصواب 900 وهذا ملفك بعد التعديل بالتوفيق ترتيب الطلاب حسب السن.rar

بعد التجربة على الملف المرفق من الأستاذ حسين تبين لي ما يلي: مشكلة الكود الموجود في المشاركة رقم 1 هو وجود مسافة بعد ok في الشرط رغم أنها تكتب بدون مسافة في الكود And Cells(a, 14) <> "ok " Then بالإضافة إلى عدم وضع جميع شروط or بين قوسين لأنها جميعا تمثل حالة واحدة من and وهذه النقطة هي مشكلة الكود الموجود في المشاركة هذه وبعد فهمي للمطلوب عمليا يمكن تعديل الكود للتالي: Sub recp_fill2() Application.ScreenUpdating = False For I = 5 To [a10000].End(xlUp).Row If Cells(I, 14) <> Cells(I, 13) And Left(Cells(I, 13), 6) = "recept" Then With Sheets("recept") .Cells(4, 2) = Cells(I, 2) .Cells(6, 2) = Cells(I, 5) .Cells(7, 2) = Cells(I, 6) .Cells(8, 2) = Cells(I, 8) .Cells(21, 2) = Cells(I, 13) End With Cells(I, 14) = Cells(I, 13) Exit For End If Next I Application.ScreenUpdating = True MsgBox "!تم الترحيل بنجاح", vbInformation + vbMsgBoxRight, "تم الترحيل" Range("b6").Select End Sub مشكلتنا فعلا هي عدم القدرة على تحديد وتوصيل المطلوب بطريقة صحيحة بالتوفيق

بارك الله فيك اخي الكريم

بعد تحميل الملف لم أجد أي توقيت ورغم ذلك إذا أردت إخفاء النموذج الحالي يمكنك استعمال الكود التالي: me.hide وطبعا يمكنك استعمال if للتحكم في شرط إخفاء النموذج

شكرا اخى

وعليكم السلام-جرب هذا الفيديو أو جرب هذا الموقع Microsoft Has Stopped Working

شكر الله لك أخي عبدالرحمن هاشم ، فيما أغنيتني فيه عن الرد ((ما جُمِعَ شيءٌ أفضل من علمٍ إلى حلم ))

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