Moosak

شكرا لتهانيكم الجميلة إخواني الأعزاء 😊🌹

@طاهر الوليدي هكذا مثلا ؟

هناك العديد من المواقع التي توفر لك العشرات من الأيكونات .. ولكن المعتمد لدي وهو أسهلها برنامج صغير اسمه ICONS8 .. ويعمل بنظام السحب والإفلات .. يعني الأيكونة اللي تعجبك تسحبها بالماوس من البرنامج وتحطها في المجلد المطلوب 🙂 وكذلك ميزة التحكم بحجم الأيكونات .. وألوانها .. و .. و .. و .. و .. وغيرها مع إمكانية البحث .. لتحميل آخر إصدارة من البرنامج من هنا : https://icons8.com/app/windows

وعليك السلام ورحمة الله وبركاته ياباش مهندس @ابو جودي 🙂 شكرا جزيلا لك .. حاجة دسمة ما شاء الله .. 🌹 شغال معاي وأنا نواتي 64 .. وكل أدرى بنواته 😄

عمو حمدي شيل علامة الـ & من قدام الـ txt. 🙂

عندي نموذج لشهر واحد أستخدمه في برامجي .. لكن يحتاج تطوير لإظهار جميع أشهر السنة 🙂 بس أعتقد @ابو جودي عنده 😉 أعانك الله ، ولا تنسانا بعد الفرج 🙂

من مكتبتي .. هذا مرفق من موقع أجنبي لكيفية نقل المرفقات من جدول إلى آخر .. وكيفية نقل الحقول ذوات القيم المتعددة أيضا .. حيث أنهما يشتركان في طريقة التعامل نفسها 🙂 theDBguyMVFAttachmentDemoV1.accdb

أخي النجاشي 🙂 حسب فهمي للموضوع .. موضوعك مختلف عن موضوع تسجيل الغياب نوعا ما كفكرة .. ولكن يخدمك أنت تصميم النموذج الحالي .. يمكنك الاستفادة من التصميم الحالي والبدء بعمل نموذج جديد مخصص لموضوع الميراث .. وقبل أن تبدأ بالعمل في الأكسس .. أقترح عليك أن ترسم النموذج على ورقة حتى تتضح لديك الرؤية وتعلم جميع احتياجاتك .. بعدها إبدأ ببناء الجداول بشكل صحيح مع علاقاتها .. ( جدول للورثة - وجدول للممتلكات - وجدول لحساب وتوزيع أنصبة الورثة ) ثم أنشيء النماذج ... (نموذجي إدخال لكل من (جدول للورثة - وجدول للممتلكات) ، ونموذج لحساب الميراث شبيه بالنموذج الحالي مصدره جدول الممتلكات وبه نموذج فرعي لحساب نصيب كل وارث ) هذا ما يتبادر لذهني حاليا .. 🙂 وأعتذر لك عن بناء قاعدة البيانات لضيق الوقت 🌹

أخي طاهر ظهرت لي العديد من الأخطاء لم أعرف سببها .. ومنها : وأيضا مستخدم الكثييييييييييييييييير من جملة For عدد كبير منها في الكود يمكن اختصارها لكم وحدة بس .. والأخطاء اللي عندك فيها .. أنك لم تغلق الجملة بكلمة Next لمعظمها .. هذا غير أني ما فهمت الفكرة اللي تريد توصل لها 😅

أخي حمدي جربت هذا التغيير فتم الإرسال بنجاح : غير هذه : غيرها إلى : وانطلق 🙂

وعليكم السلام 🙂 مواضيع مماثلة ومحلولة :

عذرك معك حبيب الملايين 🙂 وكلنا مقدرين .. وبانتظار مفاجآتك الحلوة اللي عودتنا عليها ☺️

الحمدلله على سلامتك حبيبنا @ابو جودي 🙂 🌹 عودا حميدا .. ومطول الغيبات جايب الغنايم 😄 ورجعت معاك الحياة للمكتبة الغانمة ☺️👌🏼

أخي العزيز @حمدى الظابط 🙂 .. ليس هناك داعي لفتح مواضيع جديدة لنفس العمل الذي تتابعه مع الإخوة ، فقط قم بالتذكير في نفس الموضوع .. وضع في الحسبان ارتباطات الإخوة ومشاغلهم الأخرى والتي قد تؤخرهم في الرد عليك . 🌹 (( للعلم تم دمج المواضيع الجديدة مع موضوعك القديم ))

ممتاز يابو أحمد .. 🙂 مقترح : ممكن تطبيقها في تقويم جدولي .. بحيث تتلون الفترة اللي يتم اختيارها بلون مختلف 🙂 .

سأحاول شرحها لاحقا بمثال تطبيقي في موضوع منفصل إن شاء الله 🙂

وعليكم السلام أخي @حامل المسك 🙂 لاحظ أن لرأس وتذييل الصفحة خصائص وإعدادات خاصة بها مثلها مثل بقية العناصر .. لذلك يمكنك التحكم بها أيضا بالكود .. كما تتحكم بالعناصر الأخرى عن طريق مناداتها باسمها .. ______________________________________________________________ وعليه يمكنك كتابة كود بشرط .. ( مثلا تعمل في النموذج ==> )

لا أعتقد .. ضع مثال (مرفق) أستاذنا العزيز @أبو عبدالله الحلوانى 🙂

وإياك أخي خليفة 🙂 🌹 شفتك حطيت إجابة بس ما لحقت أنزل الملف 😅 تعدد الأفكار هي عادة صحية تماماً .. 😉👌🏼 ياريت تتحفنا بفكرتك

وضعت هذه الدالة في الشروط أسفل الحقل periode : =DMax("[periode]";"[Table1]") هكذا : وهذه النتيجة 🙂 : Last Date In Query.accdb

وعليكم السلام ورحمة الله وبركاته 🙂 ربما الخطأ في اسم الجدول .. ألاحظ أنك وضعت اسم الاستعلام في الدالة .. MbljMsdd:Dsum("TotalMosthk";"HafeTotalKlsaQry";"PaydDon=-1 AND MhdrTyp=" & [MhdrTyp])

جمعتهم لك في استعلام : NoOfStudents: CInt(DSum("[students]";"[lagnas]";"CInt([lagna]) >=" & [startt] & " And CInt([lagna]) <=" & [endd])) NoOfStudents.accdb

تفضل أخي أزهر 🙂 (1) هذه الأكواد الاثلاثة لأزرار [إضافة ملف] و [فتح الملف] و [حذف الملف] : Private Sub AddFilesBtn_Click() '================================================================ هذا الجزء يوضع على الزر الذي يضيف الملف Dim file As String Dim fileName As String Dim SavePath As String If Me.NewRecord Then MsgBox "أكتب التفاصيل أولا", vbOKOnly, "": Exit Sub file = selectFile If IsBlank(file) Then Exit Sub fileName = GetFileName(file) SavePath = BECurrentPath & "attachments\" & [ID] & "\" & fileName ' يتم حفظ الملف في مجلد المرفقات بجانب قاعدة البيانات في مجلد بنفس رقم الآيدي MkDir (BECurrentPath & "attachments\") MkDir (BECurrentPath & "attachments\" & [ID] & "\") FileCopy file, SavePath ' حفظ المسار في مربع النص Me.filepath = fileName Me.Refresh MsgBox "تم إضافة الملف بنجاح" End Sub '================================================================ هذا الجزء يوضع على الزر الذي يفتح الملف Private Sub BrowserBtn_Click() On Error GoTo ErrorFix If Not IsBlank(Me.filepath) Then If IsFileExists(Me.filepath) = False Then MsgBox "لا يمكن العثور على الملف" Else OpenPath Me.filepath End If Exit Sub Else MsgBox "لا يوجد مرفقات" Exit Sub End If ErrorFix: If Err.Number = 0 Then On Error Resume Next Else MsgBox Err.Number & "\\\" & Err.Description End If End Sub '================================================================ هذا الجزء يوضع على زر الحذف Private Sub DeletBtn_Click() On Error GoTo whathapen If MsgBox("هل أنت متأكد من رغبتك في حذف المرفق ؟", vbYesNo, "تأكيد الحذف") = vbYes Then Else Exit Sub End If If Not IsBlank(Me.filepath) Then If IsFileExists(Me.filepath) = False Then MsgBox "لا يمكن العثور على الملف" Exit Sub Else DleteFolder BECurrentPath & "attachments\" & [ID] Me.Attachment = "" MsgBox "تم حذف الملف" Exit Sub End If Else MsgBox "لا توجد مرفقات" Exit Sub End If whathapen: If Err.Number = 53 Then MsgBox "لا توجد ملفات لحذفها" Exit Sub ElseIf Err.Number = 0 Then On Error Resume Next Else MsgBox Err.Number & "\\\" & Err.Description End If End Sub (2) وهذه الأكواد ضرورية لتشغيل الأكواد السابقة .. ضعها في موديول منفصل : Public Function selectFile() On Error GoTo ErrHandler Dim fd As FileDialog Dim filedialogPath As String Set fd = Application.FileDialog(msoFileDialogFilePicker) fd.AllowMultiSelect = False fd.Title = "حدد الملف المطلوب" ' fd.InitialFileName = CurrentProject.Path fd.Filters.Clear fd.Filters.Add "كل الملفات", "*.*" If fd.Show = True Then selectFile = fd.SelectedItems(1) ' Exit Function Else MsgBox "لم تقم باختيار أي ملف" Exit Function End If ErrHandler: If Err.Number = 0 Then Exit Function Else MsgBox "Error Number : " & Err.Number & " :::: " & Err.Description ' End If End Function Public Function IsBlank(arg As Variant) As Boolean Select Case VarType(arg) Case vbEmpty IsBlank = True Case vbNull IsBlank = True Case vbString IsBlank = (LenB(arg) = 0) Case vbObject IsBlank = (arg Is Nothing) Case Else IsBlank = IsMissing(arg) End Select End Function Public Function GetFileName(txtPath As String) As String ' To Extract File Name From A given Path GetFileName = Right(txtPath, Len(txtPath) - InStrRev(txtPath, "\")) End Function Public Function IsFileExists(txtPath As String) As Boolean ' To check whether a given file or folder exists or not If Len(Dir(txtPath, vbDirectory)) = 0 Then IsFileExists = False Else IsFileExists = True End If End Function Public Sub OpenPath(strpath As String) Shell "explorer.exe" & " " & strpath, vbNormalFocus End Sub Public Function DleteFolder(FolderPath As String) Dim fs As Object Set fs = CreateObject("Scripting.FileSystemObject") fs.DeleteFolder FolderPath, True Set fs = Nothing End Function Public Function BECurrentPath() On Error GoTo ErrHandler Dim FullLinkedPath As String Dim LinkedDBPath As String FullLinkedPath = Nz(DLookup("Database", "MSysObjects", "Type=6"), "") If FullLinkedPath <> "" Then LinkedDBPath = Left(FullLinkedPath, InStrRev(FullLinkedPath, "\") - 1) BECurrentPath = LinkedDBPath & "\" Else BECurrentPath = CurrentProject.Path & "\" End If ErrHandler: If Err.Number = 0 Then Exit Function Else MsgBox "Error Number : " & Err.Number & " :::: " & Err.Description End Function

أو جرب هذا 🙂 : Password Input Box.accdb

أرني ماذا فعلت .. لعلك على بعد خطوة من النجاح 🙂