kanory

ممكن عن طريق كود عند تحميل النموذج يلزم الاكسس استخدام لغة مثلا عربية . السعودية او عربية . عمان وغيرها Private Declare PtrSafe Function LoadKeyboardLayout Lib "user32" _ Alias "LoadKeyboardLayoutA" (ByVal pwszKLID As String, ByVal Flags As Long) As Long Private Declare PtrSafe Function ActivateKeyboardLayout Lib "user32" _ (ByVal HKL As LongPtr, ByVal flags As Long) As LongPtr Private Sub Form_Load() Dim hkl As LongPtr ' 00000401 = Arabic (101) hkl = LoadKeyboardLayout("00000401", 1) ActivateKeyboardLayout hkl, 0 End Sub

بارك الله فيك وفي عملك اخي @محمود حموده جهد مبارك

اخي الكريم @ابوخليل للاسف لم اعرف السبب او التشخيص ولكن العلاج كان شعبيا بحت كل ما فعلته اضفت رأس للتقرير الفرعي فقط 😀 وجعلته صغيرا جدا حتى لا يظهر لكن يبقى السؤال لما تحدث هذه الظاهرة ؟؟؟؟ اذا ... العلاج شعبي ومسكن فقط 😁

تفضل :::::::: KAN1.accdb

استبدل الكود الموجود لديك بهذا Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer) If Me.txtCount > 12 Then Cancel = True ' يخفي أي سجل أكبر من 12 End If End Sub انظر .... هل هذا هو المطلوب KAN.accdb

تفضل .... غير الشيفرة التي لديك بهذه .... On Error GoTo XYZ If MsgBox("سوف تقوم بحذف الكلية التي ليس لها قسم", vbCritical + vbYesNo, "تحذير") = vbYes Then DoCmd.SetWarnings False DoCmd.OpenQuery "query1" Me.List6.Requery MsgBox "تمت عملية حذف السجلات المطلوب حذفها بنجاح" Else Exit Sub ' خروج فوري إذا المستخدم ضغط "لا" End If Exit Sub ' خروج قبل جزء معالجة الأخطاء '==================== XYZ: MsgBox "حدث خطأ: " & Err.Description

انظر الاستعلام SALESQT قمت بحذف الحقلين وممكن تستخدم عبارة تعبير Expression كما في الصورة

تفضل ...... EL-DATA- T.rar

تفضل ................. EL-DATA.accdb

تعدل هذا cmbType حسب اسم القائمة المنسدلة لديك لو ارفقت مرفقك لكان التعديل عليه افضل لك

جرب بهذه الصورة اذا كنت قد فهمت مطلوبك بالشكل الصحيح Private Sub cmbType_AfterUpdate() ' تعبئة حقل النوع في الجدول Me.نوع = Me.cmbType.Column(1) ' عمود النوع ' تعبئة حقل التصنيف بناءً على النوع Me.تصنيف = Me.cmbType.Column(2) ' عمود التصنيف End Sub

تفضل .................... مثال1.accdb

جرب المرفق التالي ............ LAb (1).accdb

تفضل .................... مثال.accdb

هل هذا التصور المطلوب ....................... على كل حال جرب الموفق .................... مثال.accdb

هذا اعتمده رئيس احدى البلديات في احدى المناطق .... حتى يضمن تواجد الموظفين ....

الف . الف . مبروك @Ahmos تستاهل ... ومزيد من الابداع

الف . الف . مبرك اخي @Foksh يستاهل من ضحى بوقته وجهده وعلمه للاعضاء ... مزيد من التألق

الدالة هي التي تستخدم ايام الاسبوع ولاتظهر في الاستعلام مطلقا

تفضل جرب استاذي الفاضل كل الاحتمالات ...................... واعملنا بالنتيجة Database1 (36).accdb

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

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

تفضل ....................... ‏‏القرآن الكريم 2.accdb

استخدم هذه الشيفرى Private Sub Command30_Click() Dim rs As DAO.Recordset With Forms("القرآن الكريم") Set rs = .RecordsetClone rs.FindFirst "SurahNo = 1" ' عدّل القيمة حسب ما تريد البحث عنه If Not rs.NoMatch Then .Bookmark = rs.Bookmark Else MsgBox "لم يتم العثور على السورة المطلوبة.", vbExclamation End If End With End Sub Private Sub Command33_Click() Dim rs As DAO.Recordset With Forms("القرآن الكريم") Set rs = .RecordsetClone rs.FindFirst "SurahNo = " & Me![SurahNo] + 1 If Not rs.NoMatch Then .Bookmark = rs.Bookmark Else MsgBox "لم يتم العثور على السورة السابقة.", vbExclamation End If End With End Sub Private Sub Command34_Click() Dim rs As DAO.Recordset With Forms("القرآن الكريم") Set rs = .RecordsetClone rs.FindFirst "SurahNo = " & Me![SurahNo] - 1 If Not rs.NoMatch Then .Bookmark = rs.Bookmark Else MsgBox "لم يتم العثور على السورة السابقة.", vbExclamation End If End With End Sub Private Sub Command35_Click() Dim rs As DAO.Recordset With Forms("القرآن الكريم") Set rs = .RecordsetClone rs.FindFirst "SurahNo = 114" ' عدّل القيمة حسب ما تريد البحث عنه If Not rs.NoMatch Then .Bookmark = rs.Bookmark Else MsgBox "لم يتم العثور على السورة المطلوبة.", vbExclamation End If End With End Sub طبعا التعديل على المثال الاول الذي اوردته انت

طلبك غريب شوي ,,,,,, لكن استخدم هذه الاكواد ............................... Private Sub Form_Load() Dim db As DAO.Database Dim obj As AccessObject Dim strPath As String Dim strFile As String Dim RowSource As String ' إضافة النماذج الموجودة (مع استثناء نموذج "main") Set db = CurrentDb For Each obj In CurrentProject.AllForms If LCase(obj.Name) <> "main" Then RowSource = RowSource & "نموذج:" & obj.Name & ";" End If Next obj ' البحث عن ملفات إكسل في نفس مسار قاعدة البيانات strPath = CurrentProject.Path & "\" strFile = Dir(strPath & "*.xlsx*") ' يشمل xls و xlsx Do While strFile <> "" RowSource = RowSource & "ملف:" & strFile & ";" strFile = Dir Loop ' تحديث مصدر الصفوف لمربع التحرير والسرد If Right(RowSource, 1) = ";" Then RowSource = Left(RowSource, Len(RowSource) - 1) End If Me.مربع_تحرير_وسرد1.RowSourceType = "Value List" Me.مربع_تحرير_وسرد1.RowSource = RowSource End Sub Private Sub مربع_تحرير_وسرد1_AfterUpdate() Dim selectedItem As String selectedItem = Me.مربع_تحرير_وسرد1.Value If Left(selectedItem, 6) = "نموذج:" Then DoCmd.OpenForm Mid(selectedItem, 7) ElseIf Left(selectedItem, 4) = "ملف:" Then Dim filePath As String filePath = CurrentProject.Path & "\" & Mid(selectedItem, 5) Dim xlApp As Object On Error Resume Next Set xlApp = CreateObject("Excel.Application") On Error GoTo 0 If Not xlApp Is Nothing Then xlApp.Visible = True xlApp.Workbooks.Open filePath Else MsgBox "تعذر تشغيل Microsoft Excel.", vbExclamation End If End If End Sub