Moosak

أخي طاهر ظهرت لي العديد من الأخطاء لم أعرف سببها .. ومنها : وأيضا مستخدم الكثييييييييييييييييير من جملة 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

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

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