Moosak

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

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

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

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

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

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

وضعت هذه الدالة في الشروط أسفل الحقل 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

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

جرب هذا الكود أخي @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

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

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