Moosak

جمعتهم لك في استعلام : 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

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

جرب هذا الكود أخي @TQTHAMI 🙂 شغله مباشرة واختر المجلد المطلوب .. Sub SetFolderAttributesToHidden() Dim fso As Object Dim fldr As Object Dim folderPath As String Set fso = CreateObject("Scripting.FileSystemObject") Set fldr = Application.FileDialog(4) If fldr.Show = -1 Then folderPath = fldr.SelectedItems(1) End If If folderPath <> "" Then fso.GetFolder(folderPath).Attributes = fso.GetFolder(folderPath).Attributes + 2 MsgBox "Folder attributes set to hidden." Else MsgBox "No folder was selected." End If Set fldr = Nothing Set fso = Nothing End Sub

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

وهنا صولات وجولات حول هذا الموضوع 🙂

أخي @بوكفوس عبدالسلام يبدو أنك حذفت جميع الأكواد بالخطأ .. الملف المرفق بدون أكواد لذلك جميع القوائم لا تعمل

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

شكرا لك أستاذنا القدير أبو أحمد 🙂 هذي الأكواد مهمة للحصول على الفترات المطلوبة في كثير من الأحيان .. لكن بالنسبة للأرباع مو الأفضل أنه يكون بداية كل ربع هو اليوم اللي يتلي الربع اللي قبله ؟ 🙂 يعني: الربع الثاني 1/4 الربع الثالث 1/7 الربع الرابع 1/10

أخي @النجاشي أنت غيرت الموضوع تماما 😅🖐🏼️ يحتاج إعادة تصميم الجدول والنموذج بطريقة مختلفة عن أصلها الحالي 😄 ربما يكون هذا حل المشكلة أخي أحمد 🙂 :

وعليكم السلام ورحمة الله وبركاته 🙂 الأستاذ حمدي تم عمل المطلوب وتضبيط الكود حسب الطلب 🙂 انتبه إلى أني نقلت أمر الإرسال إلى الزر بدل أمر بعد التغيير للقائمة المنسدلة .. تجرية.mdb

وعليكم السلام ورحمة الله وبركاته 🙂 من غير تنزيل المرفق .. يمكنك أن تفعل ذلك من خلال دوال التحقق من وجود بيانات في جداول ( الولايات والبلديات ) كدالة DCount مثلا .. يتم الفحص عند فتح النموذج الرئيسي .. فإذا كان الرقم الذي تحضره الدالة أكبر من صفر يتم تفعيل القوائم الأخرى .. وإذا كانت صفر فإنها لا تعمل .. هذه هي الفكرة .. جرب تطبيقها بنفسك حتى تثري معلوماتك 🙂 وتوجد لدي طريقة أستخدمها في برامجي عندما يكون لدي شيء أريد التحقق منه دائما في أماكن متفرقة في البرنامج .. هو تحويل عملية التحقق إلى دالة عامة Public Function من نوع (True/False) .. وهذا يسهل علي معرفة النتيجة بمجرد استدعاء اسم الدالة .. بدل تكرار الكواد عدة مرات .. وهذا مثال عليها (التحقق من وجود سجلات في جدول الولايات مثلا ) : Public Function WelayatIsThere() As Boolean If DCount("*", "[Welayat_Tbl]") > 0 Then WelayatIsThere = True Else WelayatIsThere = False End If End Function وبهذا للتأكد من وجود سجلات في جدول الولايات فقط أكتب اسم الدالة هكذا : WelayatIsThere ومباشرة ستجيبك الدالة بنعم أو لا (True/False) 🙂 وهذا مثال لطريقة كتابة الكود باستخدام الدالة السابقة : Me.ListBtn.Enabled = WelayatIsThere وهذه الطريقة تغنيك عن كتابة العديد من الأسطر حيث أن الدالة ترجع أحد القيمتين (True/False) عليها سيتم تمكين القائمة أو لا .. 🙂

وهذه طريقة جعله يكتب من اليمين إلى اليسار لأستاذنا @jjafferr 🙂

هذا هو الملف الأصلي أخي .. @طاهر الوليدي 🙂 عدل فيه كما تشاء 😊 TimeSheet Project.accdb

شكرا لكم جميعاً ..فرداً فرداً..🌹🌷 ويسعدني ويشرفني أن أستمع إلى آرائكم ونصائحكم وتوجيهاتكم للرقي بالمنتدى.. طبعا تحت عناية إخواني المشرفين أيضاً 🙂🌹

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

وعليكم السلام أخي أزهر 🙂 طلبط بسيط بإذن الله ، ولكن سأعرض عليك خدمات أكثر 😊 - هل تريد نقل الملف أيضا إلى مجلد بجانب قاعدة البيانات ؟ - وإضافة زر لفتح الملف .. ؟ - وزر آخر لحذفه ؟ إذا كانت إجابتك بنعم .. فسأرفق لك الأكواد .. أما إذا كنت فقط ستكتفي بالسؤال فهذا هو الكود الذي طلبته 🙂 : On Error GoTo ErrHandler Dim fd As Object Dim filedialogPath As String Set fd = Application.FileDialog(1) fd.AllowMultiSelect = False fd.Title = "حدد الملف المطلوب" fd.Filters.Clear fd.Filters.Add "كل الملفات", "*.*" If fd.Show = True Then 'Debug.Print fd.SelectedItems(1) Me.filesource = fd.SelectedItems(1) Else MsgBox "لم تقم باختيار أي ملف" Exit Sub End If ErrHandler: If Err.Number = 0 Then Exit Sub Else MsgBox "Error Number : " & Err.Number & " :::: " & Err.Description End If

وعليك السلام أخي أحمد 🙂 متى ظهر لك الخطأ ؟ عند فتح البرنامج أم عند إدخال بيانات جديدة ؟

السلام عليكم ورحمة الله وبركاته .. في ليلة صافية والجو بين البارد والمعتدل .. وأنا أتصفح الفيس بوك .. لمحت سؤال لأحد الإخوة يطلب فيه طريقة لحساب عدد أيام الغياب والحضور للموظفين في نموذج مستمر .. فخطرت على بالي هذه الدالة الصغنونه الظريفة .. فوضعتها موضع التنفيذ مع نموذج دايناميكي لتقويم شهري كنت قد صممته سابقا مع سبق الترصد 😁 وقلت أضعه بين أيدي جنابكم لمن أراد أن يستفيد منه .. ولمن أراد أن ينفعنا بنصائحه الثمينة والسمينة 😅🖐🏼️ وهذه هي الدالة المستخدمة في عمودي مجموع الحضور والغياب : Public Function Count_Present_Absent(P_or_A As String) As Integer ' دالة لحساب عدد أيام الحضور وعدد أيام الغياب من تقويم مكون من 31 يوم ' By: Moosak 'P_or_A = Present or Absent ? وتعني أنت تريد حساب الحضور أم الغياب ' على أفتراض أن أسماء حقول الأيام هي على التوالي : Day1, Day2, Day3 ...... Dim x As Integer Dim Frm As Form: Set Frm = Screen.ActiveForm Dim PresentDays As Integer, AbsentDays As Integer Count_Present_Absent = 0 For x = 1 To 31 If Frm.Controls("Day" & x).Value Like "*ح*" Then ' حساب عدد أيام الحضور PresentDays = PresentDays + 1 ElseIf Frm.Controls("Day" & x).Value Like "*غ*" Then ' حساب عدد أيام الغياب AbsentDays = AbsentDays + 1 End If Next ' الدالة ترجع مجموع عدد أيام الحضور أو مجموع عدد أيام الغياب حسب الطلب If P_or_A = "P" Then Count_Present_Absent = PresentDays ElseIf P_or_A = "A" Then Count_Present_Absent = AbsentDays Else Set Frm = Nothing Exit Function End If Set Frm = Nothing End Function موضوع سريع وعلى الطاير قبل أن تتفلت المعلومات 😊🖐🏼️ تسجيل حضور وغياب الموظفين.accdb

وعليكم السلام ورحمة الله وبركاته أخي جمال 🙂 كجواب سريع ( لعدم وجود مرفق في مشاركتك ) .. من خصائص مربع السرد في التقرير > Data > ـ Bound Column إجعلها 2 بدل 1

سأجيبك بمثال ومرفق : هكذا يتم حفظ الروابط في الجدول ( سواء كانت بمستوى واحد أو مستويين أو كما تشاء ) : ثم ننشيء استعلام للجدول الأصلي ونضيف فيه عمود وظيفته اكمال الروابط بإحضار مسار القاعدة وإضافته للمسار المحفوظ هكذا : وأنا أستخدم هذه الدالة لإحضار رابط قاعدة البيانات ( قاعدة الجداول ) سواء كانت مقسمة أو غير مقسمة : 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 Attachments.accdb

أي تعم بالضبط أستاذنا @ابوخليل .. 🙂 وأنا أقترح أن يكتبها في الاستعلام كعمود جديد للرابط كاملا .. أو مصدر بيانات العناصر في النموذج ( مربع نص غير منظم كمثال )

🙂👇🏼

أنا والوقت .. كل واحد يركض على صوب 😅🖐🏼️ السمع والطاعة 🙂