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

ممكن Dim x As Integer Select Case Kind_pat Case Is = "lab" x = Nz(DMax("[PCode]", "lab_all", "[Kind_pat]='lab'"), 0) + 1 Case Is = "project" x = Nz(DMax("[PCode]", "lab_all", "[Kind_pat]='project'"), 3000) + 1 End Select PCode = x الملف في المرفقات 2023.accdb

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

الكود مصنوع لكي تكون الثانيه اسمها List2 كما في هذا السطر ان اردت تغييرها لابد من تغييرها في هذا السطر X = Application.Match("List2", Sheet2.Range("A2:A" & LR), 0) + 1 الاولي اكتب اسمها كما تريد ليس لها أي علاقه في الكود

ما شاء الله تبارك الله. ألف شكر أخي الكريم

وعليكم السلام ورحمه الله وبركاته تفضل هذا التعديل CommandButton1_Click من اجل LastRow1 CommandButton2_Click من اجل LastRow2 Private Sub CommandButton1_Click() Dim LR As Long, X If TextBox1.Value <> "" Then LR = Sheet2.Range("a" & Rows.Count).End(xlUp).Row X = Application.Match("List2", Sheet2.Range("A2:A" & LR), 0) + 1 LR = WorksheetFunction.CountA(Sheet2.Range("A1:A" & X)) If LR = X Then Sheet2.Rows(X).Resize(1).EntireRow.Insert ' Resize(1) عندما تمتلئ القائمه الاولي يضيف العدد بين الاقواس Sheet2.Range("a" & LR).Value = TextBox1.Value TextBox1.Value = "" Else MsgBox ("من فضلك تأكد من ادخال البيانات") End If TextBox1.SetFocus End Sub Private Sub CommandButton2_Click() Dim LR As Long If TextBox1.Value <> "" Then 'And TextBox3.Value <> "" And TextBox4.Value <> "" Then LR = Sheet2.Range("A" & Rows.Count).End(xlUp).Row Sheet2.Range("a" & LR + 1).Value = TextBox1.Value TextBox1.Value = "" Else MsgBox ("من فضلك تأكد من ادخال البيانات") End If End Sub

أخي الفاضل بيضيف 3 أيام كلما انقضى شهر و6 أيام كلما انقضى شهران !!!!!!!!! راجع المرفق جيداً............ جرب عدل تاريخ الكمبيوتر شهر أو شهران للأمام وشوف النتيجة .

مشاركة مع استاذ @kkhalifa1960 Rejected Employee.rar

تفضل أخي . Private Sub Patient__Name_BeforeUpdate(Cancel As Integer) Dim NameFd NameFd = Me.Patient__Name Dim a a = DLookup("[Patient_Name]", "PatientsData", "[Patient_Name]='" & Me.Patient_Name & "'") If Not (IsNull(a)) Then MsgBox "This Name : ( " + NameFd + " ) registered before " + vbNewLine + vbNewLine + " It cannot be repeated " + vbLf + vbLf + " pre-recorded records ", vbCritical + vbMsgBoxRight, "ÃäÜÜÊÈÇå : Warning" Cancel = True Me.Undo DoCmd.FindRecord NameFd End If End Sub

تفضل التعديل..ارجو ان يكون مطلبك missing years.rar

الشكر لله اخى

الحمد لله الذي بنعمته تتم الصالحات

تفضل اخي Option Explicit Sub Test() Dim WSData As Worksheet, WSResult As Worksheet, Arr, Ar1, Ar2 Dim I As Long, J As Long, P As Long Application.ScreenUpdating = False Application.EnableEvents = False Set WSData = Worksheets("Sheet1") Set WSResult = Worksheets("Sheet2") Arr = WSData.Range("C10:AB" & WSData.Cells(Rows.Count, 3).End(xlUp).Row).Value ReDim temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2) - 2) Ar1 = Array("سكر", "أرز", "بطاطس", "عنب") Ar2 = Array("زيادة", "ناقص", "بكثرة", "محتاج") Dim x For I = 1 To UBound(Arr, 1) P = P + 1 For J = 1 To UBound(Arr, 2) - 2 If J < 13 Then temp(P, J) = Arr(I, J) ElseIf J > 22 Then temp(P, J) = Arr(I, J + 2) Else x = Application.Match(Arr(I, J + 1), Ar1, 0) If Not IsError(x) Then temp(P, J) = Ar2(x - 1) temp(P, J + 1) = Arr(I, J + 1) Else temp(P, J) = "مخزن" temp(P, J + 1) = Arr(I, J + 1) End If J = J + 1 End If Next J Next I If P > 0 Then WSResult.Range("C10").Resize(P, UBound(temp, 2)).Value = temp Application.EnableEvents = True Application.ScreenUpdating = True End Sub

ما شاء الله تبارك الرحمن ابداع استاذنا الاستاذ حسونة

الله يبارك فيك ارجو أن يتسع صدرك اخوك لسه بيتعلم

تفضل Dim sysFo, sysFi, foldry, filey As Object, i As String, X As Integer Set sysFo = CreateObject("Scripting.FileSystemObject") With Application.FileDialog(msoFileDialogFolderPicker) If .Show Then Set sysFi = sysFo.GetFolder(Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)) Set foldry = sysFo.GetFolder(sysFi).Files For Each filey In foldry i = sysFo.GetAbsolutePathName(filey) i = UCase(i) Text4.AddItem (filey) Next End If End With Set sysFo = Nothing Set sysFi = Nothing Set foldry = Nothing Viewer2.accdb

الله يبارك فيك اخي ابو طارق عقبال عند اولادك

الجزء 2 سنقوم ضمن هذا الجزء بشرح تطبيقات عملية وبعض دقائق الأمور الحاسمة و المهمة ، كي نتمكن من إستخدام SQL بسهولة ويسر . ومن خلال هذا الفصل سيتم شرح وتفصيل جملة (عبارة) SELECT وتستخدم عبارة SELECT لتحديد البيانات من قاعدة بيانات ، ويتم تخزين النتيجة في جدول النتيجة، المسمى ( مجموعة النتيجة ) result-set . SELECT بناء الجملة SQL SELECT Syntax SELECT column_name(s) FROM table_name و .... SELECT * FROM table_name[/right] ومثال ذلك تعاملنا مع الجدول Employees من قاعدة البيانات المختارة للتطبيق Northwind نريد تحديد مضمون الأعمدة "LastName" و "FirstName" من الجدول Employees ، فنستخدم العبارة التالية : SELECT LastName,FirstName FROM Employees أو SELECT Employees .LastName, Employees .FirstName FROM Employees; SELECT Employees .* FROM Employees; فائدة : النجمة (*) هو وسيلة سريعة لتحديد كافة الأعمدة! ويكون شكل result-set كما كما في الاستعلام Q_SelectAll ....................................... NA_NorthwindSQL.rar ويكون شكل result-set كما في الاستعلام Q_Select SELECT * نريد تحديد كافة الأعمدة من الجدول Employees ، فنستخدم العبارة التالية : SELECT * FROM Employees أو

SQL DML and DDL ويمكن تقسيم SQL إلى قسمين: لغة معالجة البيانات (DML) لغة تعريف البيانات (DDL). الاستعلام وأوامر التحديث تشكل جزء DML • SELECT (حَدِد ) - استخلاص البيانات من قاعدة البيانات • UPDATE ( تحديث) - تحديثات البيانات في قاعدة البيانات • DELETE ( حذف ) - حذف البيانات من قاعدة البيانات • INSERT INTO (إدراج) - إدراج بيانات جديدة في قاعدة البيانات الجزء DDL من SQL يسمح لجداول قاعدة البيانات أن يتم إنشاؤها و حذفها. ويعرف أيضا الفهارس (المفاتيح)، تحدد الروابط بين الجداول، وتفرض القيود بين الجداول. و أهم جمل (عبارات) DDL في SQL هي: • CREATE DATABASE - إنشاء قاعدة بيانات جديدة • ALTER DATABASE - تعديل قاعدة بيانات • CREATE TABLE - إنشاء جدول جديد • ALTER TABLE - تعديل جدول • TABLE DROP - حذف جدول • CREATE INDEX - ينشئ فهرس (مفتاح البحث) • INDEX DROP - حذف فهرس