كل الانشطه

مشاركة مع اساتذتنا تفضل استاذ @Lotfy14 نموذج كان لدي طورته حسب طلبك بالجزء الأول يمكن يفيدك . DDTempTest 2312025.accdb

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

وعليكم السلام ورحمة الله وبركاته طريقتان واختاري ما يتاسبك الاولى ان يكون الملفان مفتوحان في نفس الوقت ونفس المجلد وبنفس الاسم تحديث عدد الطلاب2 ( يمكن تعديله من الكود) ملف الطلاب الاصل.xlsb الثانية الملف مقفول وبأي اسم بمعنى عند الضغط على زر تحديث البيانات تظهر واجهة نخنار الملف المراد اخد البيانات منه ملف الطلاب الاصل2.xlsb اتمنى ان يكون طلبك في احد الملفين لك كل التقدير والاحترام

تفضل استاذ @تامر خليفه المرفق وبه الثلاث طلبات . DDTempTest 003.rar

مرفق مقترح المقارنة كميات وأصناف بكل مخزن وبها ملاحظات الاصناف الراكدة لكل مخزن(6).xlsm

ربما بهذه الحلقة تكفي: For i = 1 To 14 formOrReport.Controls("txt" & i) = Mid(nationalID, i, 1) Next i

وفيكم اخي الكريم .. شكراً لمرورك العطر

بالنسبة لعدد الاصناف الراكدة والمتحركة هذا الكود يعمل اريد كود لعرض كميات الاصناف على حسب كل فرع سواء متحركة او راكدة Sub مقارنة_الاصناف() Const stagnantPeriod As Integer = 90 Dim ws As Worksheet, dest As Worksheet, ShArr As Variant, Ky As Object, KyStagnant As Object Dim lastRow As Long, i As Long, d As Object, cate As Variant, Irow As Long Dim item As String, item_Name As String, Store As String, Movement As Date, C As Variant Dim quantity As Double ShArr = Array("مخزن الرئيسي", "فرع 1", "فرع 2", "فرع 3", "فرع 4", "فرع 5") Set d = CreateObject("Scripting.Dictionary") Set Ky = CreateObject("Scripting.Dictionary") ' لحساب الأصناف المتحركة Set KyStagnant = CreateObject("Scripting.Dictionary") ' لحساب الأصناف الراكدة For Each C In ShArr On Error Resume Next Set ws = ThisWorkbook.Sheets(C) On Error GoTo 0 If ws Is Nothing Then MsgBox "خطأ في الوصول إلى الورقة: " & C, vbCritical: Exit Sub Application.ScreenUpdating = False lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row For i = 2 To lastRow item = ws.Cells(i, 1).Value item_Name = ws.Cells(i, 2).Value Store = ws.Cells(i, 4).Value Movement = ws.Cells(i, 3).Value If item <> "" And Store <> "" Then If IsDate(Movement) Then ' Check for both stagnant and moving items based on the period If DateDiff("d", Movement, Date) > stagnantPeriod Then ' Stagnant item If Not d.Exists(Store) Then d.Add Store, New Collection If Not n(d(Store), item) Then d(Store).Add item If Not KyStagnant.Exists(Store) Then KyStagnant.Add Store, 0 KyStagnant(Store) = KyStagnant(Store) + 1 Else ' Moving item within the period If Not d.Exists(Store) Then d.Add Store, New Collection If Not n(d(Store), item) Then d(Store).Add item Ky(Store) = Ky(Store) + 1 ' Count moving items for the store End If End If End If Next i Next C On Error Resume Next: Set dest = Worksheets("مقارنة الاصناف"): On Error GoTo 0 If dest Is Nothing Then Set dest = Worksheets.Add: dest.Name = "مقارنة الاصناف" Else dest.Cells.ClearContents End If ' Create headers for stagnant and moving items dest.[A1].Resize(1, 3) = Array("المخزن", "عدد الأصناف الراكدة", "عدد الأصناف المتحركة") Irow = 2 On Error Resume Next For Each cate In Ky.Keys dest.Cells(Irow, 1).Value = cate ' Check if there are stagnant items for this store If KyStagnant.Exists(cate) Then dest.Cells(Irow, 2).Value = KyStagnant(cate) ' عدد الأصناف الراكدة End If dest.Cells(Irow, 3).Value = Ky(cate) ' عدد الأصناف المتحركة Irow = Irow + 1 Next cate Application.ScreenUpdating = True End Sub

عشان تعرف بس معزتك قد ايه

دى فكرتى فى وحدة نمطيه عامة نضع الكود التالى Public Sub SplitNationalID(formOrReport As Object, nationalID As String) Dim i As Integer Dim ctrl As Control ' التأكد من أن الرقم القومي يحتوي على 14 رقمًا If Len(nationalID) <> 14 Then MsgBox "الرقم القومي يجب أن يتكون من 14 رقمًا!", vbExclamation Exit Sub End If ' فصل الرقم القومي إلى أرقام فردية وتعيينها إلى مربعات النص For Each ctrl In formOrReport.Controls If TypeName(ctrl) = "TextBox" And Left(ctrl.Name, 3) = "txt" Then i = Val(Mid(ctrl.Name, 4)) ' استخراج الرقم من اسم مربع النص (مثل txt1, txt2, إلخ) If i >= 1 And i <= 14 Then ctrl.Value = Mid(nationalID, i, 1) End If End If Next ctrl End Sub على ان يكون فى النموذج عدد 15 مربع النص مربع النص الاول يكون باسم : txtNationalID والباقى تكون اسمائهم txt1 الى txt14 وزر امر عند الضغط عليه يتم استدعاء الدالة بالشكل التالى SplitNationalID Me, Me.txtNationalID.Value ونفس الموضوع للتقرير على ان يتم الاستدعاء عند الفتح وانا اكتب انت تضع المرفق لا وبتفكر زى افكار بس انا فكرتى اكثر مرونه منك 😛😄

الحمد لله ...بالتوفيق يارب

هذه محاولتي البسيطة Test ID.accdb

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

ايه ده مش ممكن نفكر بمرونه شويه يا ناس ؟ افضل انا اكتب اسماء ال 14 مربع نص فاضى انا بقه صح طبعا امزح مع استاذى و معلمى الاستاذ القدير @AlwaZeeR

باعتقادي لم تكن بحاجة لهذه الخطوة ،كنت أشارك مع الأساتذة دون الإطلاع على المرفق ، وأنصحك بالإبتعاد عن الأسماء المحجوزة لآكسيس مثل Image كتسمية لعنصر من عناصر النموذج .. الحمد لله على حل مشكلتك

السلام عليكم 1- بارك الله بجهودكم جميعا اخواني الاعزاء 2- قمت بتغيير نسخة الاوفس باخرى افضل واشتغل الكود عندي بهذا السطر ادنا الذي ارسلة الاستاذ قاسم If IsNull(Me.Image.Picture) Or Me.Image.Picture = "" Or Me.Image.Picture = "(none)" Or Me.Image.Picture = "(بلا)" Then 3- كود الاستاذ ابو عارف اشتغل فورا بوركتم جميعا...

السلام عليكم أخي محمد جرب احد حلول على طريقة تحقق من مسار الصور DataH.zip

Private Sub Command5_Click() If Me.Image.Picture <> Application.CurrentProject.Path & "\Pictures\" & Me.FirstName & ".jpg" Then Me.Note1 = Null End If End Sub

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

الشكر لله

استاذ @ابو عارف جزيل الشكر

بيض الله وجهك .... فعلا عملت قاعدة جديدة فارغة وطبقت الخطوات وعمل بشكل سليم ما رأيك بهذا وجدته في أحد المنتديات الاجنبية ويقوم بنفس العمل With CreateObject("htmlfile") .parentWindow.clipboardData.clearData ("Text") End With

طالما ان الرسالة لا تظهر عندك ..اغلب الظن المشكلة في نسخة الاوفيس

اخواني الكرام اتعتقدون ان برنامج الاكسس لدي غير متكامل كونه صغير الحجم ومحمل من الانترنيت فلماذا يعمل لديكم الكود وعندي لا يعمل

ههههه الله يكون بعون الجميع يمكن للمكتبات دور عندك جرب هذا .. اضفت مكتبة رئيسية علما انه يعمل عندي بدونها Data3.rar