نجوم المشاركات

وعليكم السلام ورحمة الله تعالى وبركاته إضافة عمود في الليست بوكس أوفيسنا 2.xlsm

حل رائع للاستاذ/ محمد إليك حل آخر بالأكواد مع اظهار الكلمات المكررة وعددها الاقتباس 2.xlsm

يمكنك تجربة هذه المعادلة =SUMPRODUCT(--ISNUMBER(SEARCH(" " & TRIM(MID(SUBSTITUTE(A2," ",REPT(" ",100)), (ROW(INDIRECT("1:" & LEN(A2)-LEN(SUBSTITUTE(A2," ",""))+1))-1)*100+1, 100)) & " ", " " & $D$2 & " "))) بالتوفيق

الصراحة أن هذه المشكلة مثل المخدر الذي لا يستطيع الشخص الإقلاع عنا إلا بحلها وكلما قلت سأقلع عن التفكير فيها أرجع لها وبقوة توصلت أخيرا لدالة تحويل تشية دوال التحويل المضمنة (CStr أو CDbl أو CDate) ولكنها بإسم CSql تقوم بتحويل جميع أنواع البيانات لتلائم أوامر Sql وللمفاجأة نجحت في العمل كل الذي سويته أني عدلت [date1] الى cSql([dat1]) وأزلت علامتي # لأن الدالة ستقوم بهذا العمل (لم أقم بتطبيقها مع حقل [user_id] لأنها تعرفت عليه كرقم وبالتالي لم تضيف علامة التنصيص له فأبقيت الحال على ماهو عليه) وبالفعل كانت النتيجة كما هو متوقع والسبب في ذلك في إعتقادي أن الدالة قامت بمراعاة الإعدادات الإقليمية عند قراءة التاريخ فالتاريخ #03/06/2025# في بلدات تعني اليوم الثالث من الشهر السادس وفي بلدان اخرى تعني اليوم السادس من الشهر الثالث وهذا هو سبب الإلتباس المنطقي للمشكلة في إعتقادي عموما ارفقت الملف الأصلي بعد تطبيق هذه الدالة ليكون حل من ضمن الحلول الذي قام بها بقية الأساتذة مع تحياتي Public Function cSQL(ByVal varValue As Variant) As String On Error GoTo ERRORHANDLER ' تحقق إذا كانت قيمة فارغة If IsNull(varValue) Then cSQL = "NULL" Exit Function End If Select Case VarType(varValue) ' منطقية Case vbBoolean ' يستخدم أكسس -1 لـ TRUE و 0 لـ FALSE cSQL = IIf(varValue, "-1", "0") ' الأرقام 64 بت Case vbByte, vbInteger, vbLong, vbLongLong ' الأعداد الصحيحة - تحويله لنص مباشرة cSQL = CStr(varValue) ' ' الأرقام 32 بت ' Case vbByte, vbInteger, vbLong ' ' الأعداد الصحيحة - تحويله لنص مباشرة ' cSQL = CStr(varValue) Case vbSingle, vbDouble, vbCurrency ' تحويل إلى تنسيق SQL العشري باستخدام فاصل النقطة cSQL = Replace(Format(varValue, "0.######"), ",", ".") ' التاريخ Case vbDate ' تنسيق التاريخ/الوقت بنمط أكسس If TimeValue(varValue) = 0 Then cSQL = "#" & Format(varValue, "yyyy-mm-dd") & "#" Else cSQL = "#" & Format(varValue, "yyyy-mm-dd hh:nn:ss") & "#" End If ' النص Case vbString Dim str As String Dim dat As Date Dim parts() As String Dim datePart As String, timePart As String str = Trim(varValue) ' 1. سلسلة نصية بتنسيق SQL بالفعل (على سبيل المثال، #2025-04-23#) If Left(str, 1) = "#" And Right(str, 1) = "#" Then cSQL = str Exit Function End If ' 2. رقم وليس تاريخ (على سبيل المثال، "3.14") If IsNumeric(str) And Not IsDate(str) Then cSQL = Replace(Format(CDbl(str), "0.######"), ",", ".") Exit Function End If ' 3. تاريخ قصير وفقاُ الإعدادات المحلية If InStr(str, ".") > 0 Then parts = Split(str, " ") datePart = parts(0) If UBound(parts) > 0 Then timePart = parts(1) Else timePart = "" Dim datePieces() As String datePieces = Split(datePart, ".") If UBound(datePieces) = 2 Then Dim dd As Integer, mm As Integer, yyyy As Integer dd = Val(datePieces(0)) mm = Val(datePieces(1)) yyyy = Val(datePieces(2)) If yyyy < 100 Then yyyy = yyyy + IIf(yyyy < 30, 2000, 1900) End If If IsDate(DateSerial(yyyy, mm, dd)) Then dat = DateSerial(yyyy, mm, dd) If Len(timePart) > 0 And IsDate(timePart) Then dat = dat + TimeValue(timePart) cSQL = "#" & Format(dat, "yyyy-mm-dd hh:nn:ss") & "#" Else cSQL = "#" & Format(dat, "yyyy-mm-dd") & "#" End If Exit Function End If End If End If ' 4. سلسلة نصية للوقت فقط (على سبيل المثال، "23:15") If InStr(str, ":") > 0 And Not InStr(str, ".") > 0 Then If IsDate(str) Then dat = CDate(str) If DateValue(dat) = #12:00:00 AM# Then dat = Date + TimeValue(dat) cSQL = "#" & Format(dat, "yyyy-mm-dd hh:nn:ss") & "#" Exit Function End If End If End If ' 5. سلسلة تصية تمثل التاريخ/الوقت كاملا If IsDate(str) Then dat = CDate(str) If TimeValue(dat) = 0 Then cSQL = "#" & Format(dat, "yyyy-mm-dd") & "#" Else cSQL = "#" & Format(dat, "yyyy-mm-dd hh:nn:ss") & "#" End If Exit Function End If ' 6. البديل الافتراضي: السلسلة النصية الخاصة بالهروب لـ SQL cSQL = "'" & Replace(str, "'", "''") & "'" ' غير معروف Case Else ' البديل الافتراضي للأنواع الغير معروفة If IsNumeric(varValue) Then cSQL = Replace(Format(varValue, "0.######"), ",", ".") Else cSQL = "'" & Replace(CStr(varValue), "'", "''") & "'" End If End Select Exit Function ERRORHANDLER: ' الرجوع إلى الخطأ - إرجاع سلسلة الهروب cSQL = "'" & Replace(CStr(varValue), "'", "''") & "'" End Function d8.rar

انا عجبتنى الافكار بس اضفت بعض البهارات للطبخة اتمنى لكم مذاقا هنيئا Option Compare Database Option Explicit Public DebugMode As Boolean Public Sub ExportImagesToPdf( _ Optional blnShowImageNames As Boolean = True, _ Optional blnAddPageNumbers As Boolean = True, _ Optional strPdfName As String = "", _ Optional strFolderSource As String = "", _ Optional strFolderTarget As String = "" _ ) Dim strPdfPath As String Dim objFSO As Object, objFolder As Object, objFile As Object Dim objWordApp As Object, objDoc As Object, objRange As Object, objImg As Object Dim colFiles As Collection, arrFiles() As String Dim lngImgCount As Long, i As Long Dim fd As Object On Error GoTo ErrHandler ' اختيار مجلد الصور إذا لم يُمرر If Trim(strFolderSource) = "" Then Set fd = Application.FileDialog(4) With fd .Title = "اختر المجلد الذي يحتوي على الصور" If .Show <> -1 Then If DebugMode Then Debug.Print "تم إلغاء اختيار مجلد الصور." Exit Sub End If strFolderSource = .SelectedItems(1) End With End If If Right(strFolderSource, 1) <> "\" Then strFolderSource = strFolderSource & "\" If DebugMode Then Debug.Print "مجلد الصور: " & strFolderSource ' التحقق من وجود مجلد الصور If Dir(strFolderSource, vbDirectory) = "" Then MsgBox "مجلد الصور غير موجود", vbCritical + vbMsgBoxRight Exit Sub End If ' اختيار مجلد الهدف إذا لم يُمرر If Trim(strFolderTarget) = "" Then Set fd = Application.FileDialog(4) With fd .Title = "اختر المجلد لحفظ ملف PDF" If .Show <> -1 Then If DebugMode Then Debug.Print "تم إلغاء اختيار مجلد الهدف." Exit Sub End If strFolderTarget = .SelectedItems(1) End With End If If Right(strFolderTarget, 1) <> "\" Then strFolderTarget = strFolderTarget & "\" If Dir(strFolderTarget, vbDirectory) = "" Then MkDir strFolderTarget If DebugMode Then Debug.Print "تم إنشاء مجلد الهدف: " & strFolderTarget End If ' إعداد اسم ملف PDF If Trim(strPdfName) = "" Then strPdfPath = strFolderTarget & "صور_المجلد_" & Format(Now(), "yyyy-mm-dd_hh-mm-ss") & ".pdf" Else strPdfPath = strFolderTarget & strPdfName & ".pdf" End If If DebugMode Then Debug.Print "مسار ملف PDF: " & strPdfPath ' جمع الصور Set colFiles = New Collection Set objFSO = CreateObject("Scripting.FileSystemObject") Set objFolder = objFSO.GetFolder(strFolderSource) For Each objFile In objFolder.Files If LCase(objFile.Name) Like "*.jpg" Or LCase(objFile.Name) Like "*.jpeg" Or _ LCase(objFile.Name) Like "*.png" Or LCase(objFile.Name) Like "*.bmp" Or _ LCase(objFile.Name) Like "*.gif" Then colFiles.Add objFile.Path lngImgCount = lngImgCount + 1 If DebugMode Then Debug.Print "تم العثور على صورة: " & objFile.Path End If Next If lngImgCount = 0 Then MsgBox "لا توجد صور في المجلد المحدد", vbExclamation + vbMsgBoxRight GoTo CleanExit End If ' تحويل الـ Collection إلى مصفوفة ReDim arrFiles(0 To lngImgCount - 1) For i = 1 To colFiles.Count arrFiles(i - 1) = colFiles(i) Next ' فرز الصور Call SortArray(arrFiles) If DebugMode Then Debug.Print "تم فرز الصور" ' إنشاء مستند Word Set objWordApp = CreateObject("Word.Application") Set objDoc = objWordApp.Documents.Add objWordApp.Visible = False With objDoc.PageSetup .Orientation = 0 .TopMargin = 28 .BottomMargin = 28 .LeftMargin = 28 .RightMargin = 28 End With ' إضافة ترقيم الصفحات (إذا تم اختياره) If blnAddPageNumbers Then With objDoc.Sections(1).Footers(1).PageNumbers .Add 1, True .NumberStyle = 0 ' wdNumberStyleArabic With .Parent.Range .ParagraphFormat.Alignment = 1 ' توسيط .Font.Size = 8 .Font.Color = RGB(100, 100, 100) End With End With End If ' إدراج الصور For i = 0 To UBound(arrFiles) Set objRange = objDoc.Range objRange.Collapse 0 If i > 0 Then objRange.InsertBreak 2 objRange.Collapse 0 End If ' إدراج الصورة objRange.ParagraphFormat.Alignment = 1 Set objImg = objRange.InlineShapes.AddPicture(arrFiles(i), False, True) With objImg .LockAspectRatio = True If .Width > 500 Or .Height > 650 Then If .Width / .Height > 500 / 650 Then .Width = 500 Else .Height = 650 End If End If End With ' إضافة اسم الملف أسفل الصورة (إذا تم اختياره) If blnShowImageNames Then Set objRange = objDoc.Range objRange.Collapse 0 objRange.InsertAfter vbCrLf & Mid(arrFiles(i), InStrRev(arrFiles(i), "\") + 1) With objRange .ParagraphFormat.Alignment = 1 .ParagraphFormat.SpaceAfter = 6 .Font.Size = 9 .Font.Color = RGB(120, 120, 120) End With End If If DebugMode Then Debug.Print "تم إدراج الصورة: " & arrFiles(i) Next ' حذف أي فقرات فارغة في بداية المستند While objDoc.Paragraphs.Count > 0 And Trim(objDoc.Paragraphs(1).Range.Text) = "" objDoc.Paragraphs(1).Range.Delete Wend ' حذف فقرة فارغة محتملة في النهاية If objDoc.Paragraphs.Count > 0 Then With objDoc.Paragraphs(objDoc.Paragraphs.Count).Range If Trim(.Text) = "" Then .Delete End With End If ' حفظ كـ PDF objDoc.SaveAs2 strPdfPath, 17 objDoc.Close False objWordApp.Quit MsgBox "تم إنشاء ملف PDF بنجاح:" & vbCrLf & strPdfPath, vbInformation + vbMsgBoxRight CleanExit: Set objDoc = Nothing Set objWordApp = Nothing Set objRange = Nothing Set objImg = Nothing Set colFiles = Nothing Set objFolder = Nothing Set objFSO = Nothing Set fd = Nothing Exit Sub ErrHandler: If DebugMode Then Debug.Print "خطأ: " & Err.Number & " - " & Err.Description End If MsgBox "حدث خطأ: " & Err.Description, vbCritical + vbMsgBoxRight Resume CleanExit End Sub Private Sub SortArray(ByRef arr() As String) Dim i As Long, j As Long Dim temp As String For i = LBound(arr) To UBound(arr) - 1 For j = i + 1 To UBound(arr) If UCase(arr(i)) > UCase(arr(j)) Then temp = arr(i) arr(i) = arr(j) arr(j) = temp End If Next j Next i End Sub

الف شكر لكم احبتي الحلول كلها تعطي نتيجة صحيحة ،، وحل الأخ موسى الطف وأخف نعم اطلعت عليه الآن يوجد وجه شبه .. ولكن الحلول هنا افضل في التعامل مع النتيجة اكرر شكري وامتناني ،،

SELECT tblNames.UserId, tblNames.s_name, tblDays.day_id, tblDays.dayNm FROM tblDays, tblNames WHERE tblNames.UserId = [Forms]![Form1]![Combo0] AND ( (tblDays.day_id = 1 AND NOT tblNames.chekVuc1) OR (tblDays.day_id = 2 AND NOT tblNames.chekVuc2) OR (tblDays.day_id = 3 AND NOT tblNames.chekVuc3) OR (tblDays.day_id = 4 AND NOT tblNames.chekVuc4) OR (tblDays.day_id = 5 AND NOT tblNames.chekVuc5) OR (tblDays.day_id = 6 AND NOT tblNames.chekVuc6) OR (tblDays.day_id = 7 AND NOT tblNames.chekVuc7) ); اعتذر عندى مشكلة بالانترنت لا استطيع رفع مرفقات استاذى الجليل ومعلمى القدير و والدى الحبيب لا اعرف هل الافكار فى هذا الموضوع مشابهه ام تساعد فى تحقيق اى من اهدافكم الحالية او المستقبلية ام لا ولكن احسست بوجه شبه من بعيد او من قريب بينهم

وعليكم السلام 🙂 تفضل أستاذنا العود Database1_Moosa.accdb

وعليكم السلام ورحمة الله وبركاته ,, هذا يعني انه يمكن ان يكون المعيار مختلفاً !!!! طيب ، أمامك حلين اثنين في الوقت الحالي .. الأول من خلال معادلات مع الإستعانة بخلية ( عمود مساعد ) . وسيكون الحل كالآتي :- سنجعل المعايير متغيره بحيث يتم ادخال عدد الذكور والإناث وعدد القاعات في الخلايا ( i5 , j5 , h5 ) في الخلية المساعدة ولنفترض E2 ، نستعمل هذه المعادلة :- =IF(D2="M", COUNTIF($D$2:D2,"M"), COUNTIF($D$2:D2,"F")) طبعاً ، وسنسحب المعادلة الى آآآخر خلية للتنفيذ عليها . ولا مشكلة لو تم اخفائها على سبيل المثال . الآن في العمود C والخلية C2 نستخدم هذه المعادلة :- =IF(D2="M", "قاعة " & CEILING(E2/$I$5,1), "قاعة " & CEILING(E2/$J$5,1)) الثاني من خلال الماكرو التالي :- Sub DistributeStudentsToRooms() Dim ws As Worksheet Dim lastRow As Long, i As Long Dim totalRooms As Integer, malesPerRoom As Integer, femalesPerRoom As Integer Dim maleCount As Integer, femaleCount As Integer Dim roomAssignment As Integer Dim roomCounters() As Integer Dim gender As String Set ws = ThisWorkbook.Sheets("ورقة1") totalRooms = ws.Range("H5").Value malesPerRoom = ws.Range("I5").Value femalesPerRoom = ws.Range("J5").Value ReDim roomCounters(1 To totalRooms, 1 To 2) lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row ws.Range("C2:C" & lastRow).ClearContents For i = 2 To lastRow gender = ws.Cells(i, "D").Value For roomAssignment = 1 To totalRooms If gender = "M" Then If roomCounters(roomAssignment, 1) < malesPerRoom Then roomCounters(roomAssignment, 1) = roomCounters(roomAssignment, 1) + 1 Exit For End If Else If roomCounters(roomAssignment, 2) < femalesPerRoom Then roomCounters(roomAssignment, 2) = roomCounters(roomAssignment, 2) + 1 Exit For End If End If If roomAssignment = totalRooms Then roomAssignment = 0 Next roomAssignment ws.Cells(i, "C").Value = "قاعة " & roomAssignment Next i MsgBox "تم توزيع الطلاب على القاعات بنجاح", vbInformation + vbMsgBoxRight, "" End Sub وهذا ملف مرفق للطريقتين :- Desktop.zip

MCP server And workflow automaton platform السلام عليكم اصبح الترند الان في عالم الذكاء الاصطناعي هو مصطلحين MCP server And workflow automaton platform اما الاول وبدون اخذ التعريفات العلمية فهو ربط نماذج الذكاء الصناعي ب الملفات او قواعد البيانات او الاي بي اي فمن خلاله مثل في الاكسيل تستطيع من خلال امرللذكاء الصناعي من تعديل ملف او اضافة ملف او اضاف سطر او حذف وغيرها انظر هذا السيرفر https://lobehub.com/ar/mcp/haris-musa-excel-mcp-server طبعا لعمل سيرفر تستخدم بايثون او جافا سكربت بالنسبة للاكسيس هنالك محاولة من احد الاسخاص في بدايتها للتحكم ببعض ملفات الاكسيس وعمل الاستعلامات https://lobehub.com/mcp/scanzy-mcp-server-access-mdb?activeTab=deployment بالنسبة للاكسيس ساحاول ان شاء الله بمساعدة الذكاء الصناعي محاولة انشاء سيرفر اذا اتيح لي الوقت وتيسرت الامور ولم تعقد بانشاء سيرفر قد يفيد المستخدمين كون لدي معرفة جيدة ببايثون اما المصلح الثاني فهية اتمتة العمليات سواء الية او نص الية مثلا موقع n8n او pipedream وغيرها تستطيع انشاء مثلا اتمتة من استقبال السيرة الذاتية على البريد الإلكتروني وتحليلها عن طريق الذكاء الصناعي وفرزها حسب تلبية الشروط المطلوبة ثم ارسالها برسالة لشؤون الموظفين لمن يطابق الشروط بشكل الي 100٪ وفي مثالنا السابق تستطيع من خلال بوت تيليجرام من خلال رسالة نصية او صوتية مثلا ان تتحكم بملف الاكسيل من حذف واضافة وتعديل ثم ارسال الملف الى البريد الاكتروني اذا كان هناك اهتمام من الاعضاء ساقوم بشرح وافي عنهما

بالعكس ، فانت تقوم بجعل البرنامج بطئ بدون سبب !! بما ان الاكسس يقوم بما عليه وبكل اريحية ، فلماذا تغير الوضع ؟ نعم تستطيع عمل هذا بالكود ، بتحميل بيانات الاستعلام التي تم معالجتها دفعة واحدة ، ولكنك ستدفع ثمن التأخير : dim rst as dao.recordset set rst=currentdb.openrecordset("Select * From Query1") rst.movelast rst.movefirst او في النموذج المستمر ، عند تحميل النموذج: docmd.gotorecord,,aclast docmd.gotorecord,,acfirst

ولا يهمك أخي الفاضل .. استكمل باقي المطلوب بشكل واضح ، وإن شاء الله تجد مطلبك ..

استاذي الفاضل Foksh كلمة شكرا قليلة في حقك ممنون من حضرتك يا طيب نسأل الله جل شأنه ان يمن عليك بالصحة والعافية والخير والبركات تمام 100 % ما نستغنى عن حضرتك يا طيب

انت تأكد كلامي ولكن بعدد سجلات مختلف (قد يعتمد على العدد الذي تم عرضه) ، فلو ان الاكسس "كان يعالج باقي السجلات تدريجيا فقط في الخلفية" ، لحصلت على العدد 100 ، وهو عدد سجلات الكامل في الجدول.

طيب ، جرب هذا الحل الذي لا يعتمد على اي تقرير أو جدول , حيث سيتم قراءة الصور من المجلد A1 ، ثم دمجها إلى ملف PDF داخل المجلد PDF . لم أضف فكرة حذف الصور بعد الدمج حتى تتأكد من أن هذا طلبك 100% Arshafah.zip

طيب تمام ، الآن اللي وضح لي كالآتي :- 1. من خلال الزر ، تريد ان يتم دمج الصورة الى المجلد PDF بملف بصيغة PDF بحيث كل صورة في صفحة . 2. بعد التصدير ونجاح العملية ، حذف الصور وتفريغ المجلد A1 من محتوياته . لكن الغير واضح هو :- أرجو منك التوضيح بشكل يسير أخي الفاضل !!

السلام عليكم انا فخور أن مشاركاتي الطويلة يتم قراءتها ويُستفاد منها 🙂 انا دائما انظر لعملي ، انه بعد 3 اشهر او اكثر ، يرجع لي المستخدم بطلب تعديل ، وانا اكون نسيت تفاصيل برنامجي. لهذا السبب ، فلا آخذ بطريق اخوي موسى ولا ابو جودي (معلش ، محدش يزعل ) ، وانما اعمل دالة خارجية واعمل بها عدد الاسطر اللي احب من الكود ، واكتب تعليق واضح على كل سطر ، لأني لما اريد اعمل تعديل ، بكل بساطة اعرف المكان اللي اريد اعدل عليه ، ولحظات واكمل التعديل ، اما لتعديل اي شيء في معادلات اخوي ابو جودي وموسى ، فأنا مضطر احك راسي الى ان افهم شو اللي كنت عامله سابقا ، ثم افكر في مكان التعديل. ولما تستخدم دالة خارجية ، استخدم ElseIf او Case قدر الامكان ، ومع انه قد يكون عندك 100 سطر كود (مثلا) ، إلا انك في الواقع تستعمل بضع اسطر فقط ، وتكون الدالة سريعة. الدليل خير برهان 🙂 اخوي موسى فهم كلامي بالطريقة الصحيحة 🙂 ارفق مثال بسيط لأثبت قولي: عندنا جدولين . واستعلام فيه الامر Dlookup ، وانادي الدالة Add_One . الدالة Add_One Function Add_One(ID As Long, N As Long) As Double Add_One = N + 1.5 If ID = 55 Then Add_One = 55 End If End Function . الان نريد ان نثبت ان الاستعلام . سأقوم بتوقيف الاستعلام عندما يعرض على الشاشة السجل Auto_ID=55 ، وهذا معناه انه اذا ظهر السجل على الشاشة ، فسيقوم الاستعلام في الاكسس بحساب قيمته ، اما السجل الذي لم يظهر على الشاشة ، فالاكسس لا يقوم بحساب قيمته . وهنا قمت بتشغيل الاستعلام ، واظهرت 27 سجل فقط ، ثم 27 سجل آخر 27+27=54 ، ثم طلبت عرض السجل Auto_ID=55 ، فلم يعطني الاكسس الجواب ، لأنه كان بحاجة الى تمرير البيانات الى الدالة للحصول على نتيجة الدالة ، وهنا توقف الكود. . 1637.Query_Records.accdb

يعني باختصار لما تفضلت به أعلاه :- تريد ان يتم دمج الصور التي في المجلد A1 بغض النظر عن عددها أو طبيعتها أو تكراراتها ، في ملف PDF داخل المجلد A2 !!!!!؟ وإذا كان غير صحيح ما فهمته ، ارجو منك التوضيح بشكل أكثر دقة . وتحديد وظيفة الجدول tblAttach ؟؟؟؟؟

بالنسبة لي فحتى الآن لم اطبق على السجلات لكني من النظرة الاولى شدتني المعايير وكثرتها في استعلام ابي جودي وكل له وجهة نظره التي يراها .. والتطبيق على ارض الواقع هو الفيصل سوف يتعامل الاستعلام عندي ما بين 1000 الى 1500 سجل في ابعد الأحوال وسوف يتضح التنفيذ من النقرة الأولى .. ويمكن ان احذوا حذو ما يفعله الاستاذ جعفر .. بأن اطبق على سجلات كثيرة جدا بحيث يكون الفرق واضح والبضاعة عندي يمكنني حينها اختار المناسب .. وكلنا اصحاب .. خلاص .. كل واحد يسلم على الثاني

كل التقدير والاحترام لحظرتك اخي الكريم (منتصر الانسي) هذا بالضيط المطلوب وفقك الله ودمت بالف خير

نفضل المثال بعد التعديل مثال.rar

حبيبنا @ابو جودي اقرأ تعليق الأستاذ جعفر هنا 🙂 : وحسب ما يظهر أن الاستعلام هنا لا يتعدى السبع سجلات ، وهي بعدد أيام الأسبوع.

تفضل أخي الكريم ، ما تم هو:- انشاء جدول يحتوي حقل ترقيم تلقائي ( ليس ذا علاقة بالموضوع ، ولكنه عادة ... ) ، وحقل لإضافة المسارات اليه عند اختيارك للصور . ثم إنشاء تقرير مصدره الجدول السابق ، وتم إنشاء عنصر صورة مصدره المربع النصي المرتبط بالحقل الخاص بالمسارات . ثم داخل التقرير لعرض كل صورة في صفحة مستقلة ، في قسم التفاصيل = = تقسيم الصفحات بعد هذا الجزء . وفي نموذج الإفتراضي ، في الزر جعلت لك الأحداث داخل نفس الزر بحيث عند النقر عليه ، تستطيع اختيار الصور التي تريدها ، وبعد الموافقة عليها سيتم فتح التقرير وتصديره الى ملف PDF في المجلد A2 كما طلبت . وهذا من خلال الكود التالي :- Private Sub Command0_Click() Dim fd As Object, selectedFile, db As DAO.Database, rs As DAO.Recordset Dim response As Integer, exportPath As String response = MsgBox("هل تريد حذف السجلات القديمة قبل إضافة الصور الجديدة؟" & vbCrLf & vbCrLf & _ "نعم: لحذف السجلات القديمة أولاً" & vbCrLf & _ "لا: للإبقاء على السجلات القديمة وإضافة الجديدة" & vbCrLf & _ "إلغاء: لإيقاف العملية بالكامل", _ vbQuestion + vbYesNoCancel + vbMsgBoxRight, "خيارات الإضافة") If response = vbCancel Then Exit Sub exportPath = CurrentProject.Path & "\A2\تقرير_الصور_" & Format(Now(), "yyyy-mm-dd_hh-mm-ss") & ".pdf" If Dir(CurrentProject.Path & "\A2", vbDirectory) = "" Then MkDir CurrentProject.Path & "\A2" Set db = CurrentDb() If response = vbYes Then db.Execute "DELETE FROM Tbl_Foksh", dbFailOnError Set fd = Application.FileDialog(3) With fd .Title = "اختر الصور المطلوبة" .AllowMultiSelect = True .Filters.Clear .Filters.Add "ملفات الصور", "*.jpg;*.jpeg;*.png;*.bmp;*.gif" If .Show = -1 Then Set rs = db.OpenRecordset("Tbl_Foksh") For Each selectedFile In .SelectedItems rs.AddNew rs!Pic_Path = CStr(selectedFile) rs.Update Next rs.Close DoCmd.OutputTo acOutputReport, "Report1", acFormatPDF, exportPath, False MsgBox "تمت العملية بنجاح" & vbCrLf & _ IIf(response = vbYes, "تم حذف السجلات القديمة", "تم الاحتفاظ بالسجلات القديمة") & vbCrLf & _ "تم إضافة مسارات الصور الجديدة" & vbCrLf & _ "تم تصدير التقرير إلى: " & exportPath, _ vbInformation + vbMsgBoxRight, "" Else MsgBox "لم يتم اختيار أي ملفات", vbExclamation + vbMsgBoxRight, "" End If End With Set rs = Nothing: Set db = Nothing: Set fd = Nothing End Sub حيث يسمح لك الكود ، بحذف السجلات السابقة من الجدول أو الإحتفاظ بها وإضافة صور ( سجلات جديدة ) أو إلغاء العملية كاملة . ملف للتجربة :- frmPDF.zip

ما شاء الله لا قوة الا بالله .. فكرة عبقرية اعجبتني جدا .. لا تخطر على البال

ما شاء الله تبارك الله.. مزيد يارب من النجاح والتقدم وجزاكم الله خيرا على هذا المنتدى الطيب النافع المبارك جمعنا الله تحت ظله يوم لا ظل إلا ظله يارب العالمين

وعليكم السلام ورحمة الله وبركاته 🤗.. كفكرة ، قم بإنشاء تقرير يجلب الصور من مساراتها ، ثم قم بتصدير التقرير إلى ملف PDF . أعتقد هذا أنسب حل لك 😉 . أتابع من الجوال

بارك الله فيك وجزاك الله خير

السلام عليكم ورحمة الله وبركاته كود بسيط جدا لحذف المسافة بين عبد وجميع اسماء الله الحسنى اتمنى من الله عز وجل ان ينفعنا بما علمنا ... وان يعلمنا ما ينفعنا حذف المسافة.xlsm

راجع هذا الرابط https://www.officena.net/ib/topic/114544-تصميم-وعمل-برنامج-كامل-عن-أجازات-الموظفين/#findComment-690656

اما اذا اردنا استعمال Dlookup في الاستعلام ، بجميع الطرق اعلاه ، تحويل التاريخ الى رقم تعامل التاريخ هنا كرقم D1_Double: DLookUp("[date2]","[tbl2]","Cdbl([date2]) =" & CDbl([date1]) & " And [usr_id] ='" & [user_id] & "'") تنسيق التاريخ: \#mm/dd/yyyy\# تعامل التاريخ هنا كنص D1_Format_#D: DLookUp("[date2]","[tbl2]","Format([date2],'\#mm/dd/yyyy\#') ='" & Format([date1],'\#mm/dd/yyyy\#') & "' And [usr_id] ='" & [user_id] & "'") تنسيق التاريخ: yyyy-mm-dd hh:nn:ss تعامل التاريخ هنا كنص D1_Format_yyyy-mm-dd: DLookUp("[date2]","[tbl2]","Format([date2],'yyyy-mm-dd hh:nn:ss') ='" & Format([date1],'yyyy-mm-dd hh:nn:ss') & "' And [usr_id] ='" & [user_id] & "'") مناداة الدالة: DateFormat تعامل التاريخ هنا كرقم D1_Module: DLookUp("[date2]","[tbl2]","[date2]=" & DateFormat([date1]) & " And [usr_id] ='" & [user_id] & "'") . وهذه هي الدالة DateFormat : Function DateFormat(varDate As Variant) As String 'Purpose: Return a delimited string in the date format used natively by JET SQL. 'Argument: A date/time value. 'Note: Returns just the date format if the argument has no time component, ' or a date/time format if it does. 'Author: Allen Browne. allen@allenbrowne.com, June 2006. ' 'calling the Function: DateFormat(The_Date_Field) 'a = dlookup("[some field]","some table","[id]=" & me.id & " And [Date_Field]=" & DateFormat([The_Date_Field])) ' If IsDate(varDate) Then If DateValue(varDate) = varDate Then DateFormat = Format$(varDate, "\#mm\/dd\/yyyy\#") Else DateFormat = Format$(varDate, "\#mm\/dd\/yyyy hh\:nn\:ss\#") End If End If End Function . وبغض النظر عن كيفية تعاملنا مع جلب التاريخ ، سواء كان رقم او نص ، إلا ان نتيجة الامر Dlookup يكون نص . ملاحظة هامة: اذا كان حجم الشاشة يعرض 30 سجل (مثلا) ، واذا كان عندنا استعلام به 100 او 10000 سجل (اي رقم اكبر من حجم العرض 30) ، وبغض النظر عن المحتويات والقيم والاوامر والمعادلات في الاستعلام ، فالاكسس يقوم بحساب السجلات المعروضة على الشاشة فقط ، وفي حالتنا فالاكسس يحسب نتائج 30 سجل فقط ، وعليه ، اذا كان هذا الاستعلام هو مصدر بيانات لنموذج او تقرير ، فلن يكون هناك تأخير وبطئ في العرض (طبعا سيكون هناك بطئ بسيط ، ولكن ليس كما هو الاعتقاد السائد بأن البطئ سيلاحظه المستخدم) ، فالمصطلح المتداول في البطئ ، هو اذا اردت جلب بيانات الاستعلام كاملا دفعة واحدة ، مثل اذا اردت ان تبحث عن قيمة معينة فيه ، او تصدير جميع البيانات دفعة واحدة الى ملف اكسل او pdf ، بينما لا يوجد بطئ عند الطباعة لان الطباعة تتطلب بيانات صفحة واحدة فقط وهي الصفحة التي يتم طباعتها حاليا (بمعنى آخر ، حتى لو اردت طباعة 1000 صفحة ، فانت تطبعها صفحة صفحة) . مع ملاحظة تفادي استعمال فرز/تصفية للحقول التي بها معادلات والحقول التي تستعمل الامر Dlookup والحقول التي تنادي دوال خارجية ، لأنه هنا الاستعلام يجب ان يقوم بحساب قيم جميع السجلات ، ثم يقوم بعملية الفرز/التصفية. لهذا السبب ، فمناداة دالة خارجية (فيها معادلات فقط) لا تعمل بطئ عند استعمالها ، حسب ملاحظاتي اعلاه 🙂 1636.1.d8.accdb

السلام عليكم بشمهندس فادي هل هناك شروط معينة للانضمام لجروب الواتس الخاص بقسم الاكسس اذا كان متاح الانضمام بدون شروط معينة فأرجوا اضافتي من فضلك رقمي : xxxxxxx

وهذه نفس سابقتها ولكن مختصرة: = IFERROR(RIGHT(A4, FIND(".", A4, 1)),0) * 1000

ثماذج الذكاء الاصطناعي متعددة جرب مثلا : الصيني (ديب سيك) https://chat.deepseek.com/ أو الأمريكي من قوقل (جيمناي) https://gemini.google.com/app?hl=en والأمريكي أيضا (شات جي بي تي) https://chatgpt.com/ أما سؤالك بخصوص التعديل على المعادلة , فعند التعديل لا تضغط ENTER فقط بل لا بد من ضغط ثلاثة مفاتيح لأنها معادلة نطاق ARRAY وليس معادلة عادية فبعد التعديل عليها اضغط ثلاثة مفاتيح وهي : 1 Ctrl وتظل ضاغط عليه 2 Shift وتظل ضاغط عليه 3 Enter يعني : لما تضغط على الزر الأخير Enter ستكون الأزرار الثلاثة كلها مضغوطة في نفس اللحظة

تفضل أخي الكريم 3 ملفات الأول إذا كان الأوفيس عندك 365 أو 2016 فيما فوق الثاني إذا كان الأوفيس إصدار أقل من 2016 الثالث باستخدام الأكواد لا تنسى اختيار "اختر تمت الاجابة" إذا تم حل المشكلة استخراج_فواتير_بدون_تكرار (365).xlsx استخراج_فواتير_بدون_تكرار (أوفيس قديم).xlsx استخراج_فواتير_بدون_تكرار (كود).xlsm

أخي الكريم وعليكم السلام ورحمة الله وبركاته 🤗 وبما أن المشروع ليس من تأسيسك ، فأعتقد انك بحاجة الى إعادة بناء المشروع ، وليس كما تظن 3 طلبات فقط. لذا .. أنصحك بالتوجه الى عرض طلباتك واحداً واحداً في مواضيع مستقلة ، مع الشرح الكافي مصحوباً بملف يحتوي سجلات بسيطة . ملاحظة:- لم أطلع على الملف .

جرب هذا الكود Sub Hyperlink_cut() Dim selectedFile As String Dim result As Variant ' فتح مربع حوار لاختيار الملف With Application.FileDialog(msoFileDialogFilePicker) .Title = "اختر ملف Excel المراد قطع الرابط معه" .Filters.Clear .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsb; *.xlsm" .AllowMultiSelect = False If .Show = -1 Then selectedFile = .SelectedItems(1) Else MsgBox "لم يتم اختيار ملف.", vbExclamation Exit Sub End If End With ' محاولة قطع الرابط On Error Resume Next ActiveWorkbook.BreakLink Name:=selectedFile, Type:=xlExcelLinks If Err.Number <> 0 Then MsgBox "تعذر قطع الرابط. تأكد أن الملف مرتبط فعلاً.", vbCritical Exit Sub End If On Error GoTo 0 ' تحديد خلية H9 Range("H9").Select ' تحديد الشكل "Rectangle 4" On Error Resume Next ActiveSheet.Shapes.Range(Array("Rectangle 4")).Select On Error GoTo 0 ' الانتقال إلى المرجع "Macro1" On Error Resume Next Application.Goto Reference:="Macro1" On Error GoTo 0 End Sub

السلام عليكم و رحمة الله استخدم هذه المعادلة =IFERROR(INDEX($D$4:$D$1000;MATCH(0;COUNTIF($N$3:N3;$D$4:$D$1000);0));"") و لا تنسى الضغط على CTRL+SHIFT+ ENTER قبل السحب

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

تفضل جرب الملف مصادقة 1.xlsx

=IF(SUMIFS(INDIRECT("Sheet1!$F$" & $J$2 & ":$F$" & $K$2), INDIRECT("Sheet1!$D$" & $J$2 & ":$D$" & $K$2), "<=" & $G3, INDIRECT("Sheet1!$C$" & $J$2 & ":$C$" & $K$2), ">=" & $F3,INDIRECT("Sheet1!$A$" & $J$2 & ":$A$" & $K$2), $B3) = 0, "", SUMIFS(INDIRECT("Sheet1!$F$" & $J$2 & ":$F$" & $K$2), INDIRECT("Sheet1!$D$" & $J$2 & ":$D$" & $K$2), "<=" & $G3, INDIRECT("Sheet1!$C$" & $J$2 & ":$C$" & $K$2), ">=" & $F3, INDIRECT("Sheet1!$A$" & $J$2 & ":$A$" & $K$2), $B3)) =IF(SUMIFS(INDIRECT("Sheet1!$G$" & $J$2 & ":$G$" & $K$2), INDIRECT("Sheet1!$D$" & $J$2 & ":$D$" & $K$2), "<=" & $G3, INDIRECT("Sheet1!$C$" & $J$2 & ":$C$" & $K$2), ">=" & $F3, INDIRECT("Sheet1!$A$" & $J$2 & ":$A$" & $K$2), $B3) = 0, "", SUMIFS(INDIRECT("Sheet1!$G$" & $J$2 & ":$G$" & $K$2),INDIRECT("Sheet1!$D$" & $J$2 & ":$D$" & $K$2), "<=" & $G3, INDIRECT("Sheet1!$C$" & $J$2 & ":$C$" & $K$2), ">=" & $F3, INDIRECT("Sheet1!$A$" & $J$2 & ":$A$" & $K$2), $B3)) Summary Expenses.xlsx

وعليكم السلام ورحمة الله وبركاته حياك الله , الأمر يحتاج إلى متابعة لتحقيق المطلوب , لأنه من الصعب أن تجد شيءا جاهز لاحظ هذه الملفات برنامج موارد بشرية.xlsx شيت مرتبات.xlsx 611075288_OfficeSoft.EmploySalary-Source.zip

السلام عليكم ورحمة الله وبركاته أقدم لكم اليوم برنامج لتسجيل بيانات أجازات الموظفين -بارك الله فيكم ..الباسورد: 123 برنامج اجازات الموظفين.xlsm

اخوانى الكرام الملف يعمل عندى وهذه صورة الواجهة وسأرسل الملف مرة اخرى برنامج اجازات الموظفين.xlsm

نموذج خاص لمشروعك @منتصر الانسي ☕🌹❤️ لعمل زر انهاء واغلاق هذا الكود 1- الغاء الكود Private Sub Form_Unload(Cancel As Integer) ' ' منع إغلاق النموذج ' Cancel = True ' HandleCloseAttempt End Sub 2- تعديل كود زر اغلاق وانهاء كما موضع بسطر الكود في المرفق ' تعطيل إمكانية الإغلاق عند التحميل SetAccessCloseAbility False ' تفعيل إمكانية الإغلاق عند التحميل SetAccessCloseAbility True Private Sub Run_Click() On Error GoTo Qut SetAccessCloseAbility True Dim frmXrpt As Integer Dim frmX As Integer Dim rptX As Integer For frmXrpt = 1 To 1 For frmX = 0 To Forms.count - 1 DoCmd.close acForm, Forms(0).name Next frmX For rptX = 0 To Reports.count - 1 DoCmd.close acReport, Reports(0).name Next rptX Next frmXrpt 'DoCmd.Quit acQuitSaveAll SafeExit Exit Sub Qut: MsgBox err.Description End Sub =============================================== :نستفيد من اخفاء الملفات بطريقة المتاهات تذكرة لعبة المتاهات كان عند @Foksh مشكلة ما قدر يحلها المهم توضيح 1- قاعدة فارغة لتشغيل القاعدة واغلاق لماذا بسبب ان اختصار سطح المكتب يعرف فيه مكان قاعدة التشغيل 2- اجعل مجلد القاعدة الفارغه هو اختصار سطح المكتب وعند مجلده اضافة ملفات برقة بيضاء شكلا ووهم ان هذه هي القاعدة دالة التشفير وفك التفير تزيد امان مع تفعيل غفل القواعد بكلمة مرور ودالة العكس والمعالجه المهم جرب طريقة بتشغيل اختصار وهمي On Error GoTo ErrorHandler Dim folderPath As String Dim result As Long Dim fs As String fs = Application.CurrentProject.Path ' تنظيف المسار من أي فواصل أو مسافات زائدة '==================( من غير حقل مفقط مسار قاعدة folderPath = Trim(fs) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' التحقق من وجود المجلد If Dir(folderPath, vbDirectory) = "" Then MsgBox "المجلد غير موجود!", vbExclamation, "خطأ" Exit Sub End If ' إخفاء المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_HIDDEN) If result <> 0 Then Me.lblStatus.Caption = "تم إخفاء المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إخفاء المجلد!" Me.lblStatus.ForeColor = vbRed End If Exit Sub ErrorHandler: Me.lblStatus.Caption = "حدث خطأ: " & err.Description Me.lblStatus.ForeColor = vbRed واذا كان الاستخدام لمفات تتعلق بنظام او القاعدة تكتب سطر سطر من غير & Run من غير جدول من غير حقول Dim Path_X0 As String Dim Path_X1 As String Dim Path_X2 As String Dim Path_X3 As String Dim Path_X4 As String Dim Path_X5 As String Dim Path_X6 As String Dim Path_X8 As String Dim Path_X9 As String Dim Path_X10 As String Dim Path_X11 As String Dim Path_X12 As String Dim Path_X13 As String Dim Path_X14 As String Dim Path_X15 As String Dim Path_X16 As String Dim Path_X17 As String Dim Path_X18 As String Dim Path_X19 As String Dim Path_X20 As String Dim Path_X21 As String Dim Path_X22 As String Dim Path_X23 As String Dim Path_X24 As String Dim Path_X25 As String Dim Path_X26 As String Dim Path_X27 As String Dim Path_X28 As String Dim Path_X29 As String Dim Path_X30 As String Dim Path_X31 As String Dim Path_X32 As String Dim Path_X33 As String Dim Path_X35 As String Dim Path_X36 As String Dim Path_X37 As String Dim Path_X38 As String Dim Path_X39 As String Dim Path_X40 As String Dim Path_X41 As String ' On Error GoTo ErrorHandler Dim folderPath As String Dim result As Long Dim Run As Integer Path_X0 = Application.CurrentProject.Path & "\DDB_Control" Path_X1 = Application.CurrentProject.Path & "\IMG_Company" Path_X2 = Application.CurrentProject.Path & "\IMG_Company_ReP" Path_X3 = Application.CurrentProject.Path & "\IMG_Wallpaper_backgreound" Path_X4 = Application.CurrentProject.Path & "\App_IMG_Wallpaper_backgreound" Path_X5 = Application.CurrentProject.Path & "\IMG_Editor_Menu" Path_X6 = Application.CurrentProject.Path & "\Cantry_IMG" Path_X7 = Application.CurrentProject.Path & "\fonts" Path_X8 = Application.CurrentProject.Path & "\Icon_Button" Path_X9 = Application.CurrentProject.Path & "\Icon_Msgbox" Path_X10 = Application.CurrentProject.Path & "\Sound" Path_X11 = Application.CurrentProject.Path & "\Wallpaper" Path_X12 = Application.CurrentProject.Path & "\Video" Path_X13 = Application.CurrentProject.Path & "\db_BE" Path_X14 = Application.CurrentProject.Path & "\ExE" Path_X15 = Application.CurrentProject.Path & "\IMG_Report" Path_X16 = Application.CurrentProject.Path & "\File_word" Path_X17 = Application.CurrentProject.Path & "\File_Excel" Path_X18 = Application.CurrentProject.Path & "\Book" Path_X19 = Application.CurrentProject.Path & "\File_PowerPoint" Path_X20 = Application.CurrentProject.Path & "\File_Text" Path_X21 = Application.CurrentProject.Path & "\File_Code" Path_X22 = Application.CurrentProject.Path & "\All_InFile_One_Zip_Rar" Path_X23 = Application.CurrentProject.Path & "\ICOn" Path_X24 = Application.CurrentProject.Path & "\Icon_bar_DB" Path_X25 = Application.CurrentProject.Path & "\Icon_bar_Form_Report" Path_X26 = Application.CurrentProject.Path & "\Icon_Button" Path_X27 = Application.CurrentProject.Path & "\icon_Gif" Path_X28 = Application.CurrentProject.Path & "\Icon_Msgbox" Path_X29 = Application.CurrentProject.Path & "\LinkedDB_Backups" Path_X30 = Application.CurrentProject.Path & "\Office_Video" Path_X31 = Application.CurrentProject.Path & "\Qr" Path_X32 = Application.CurrentProject.Path & "\QR_User" Path_X33 = Application.CurrentProject.Path & "\Resources" Path_X34 = Application.CurrentProject.Path & "\World_Cantry" Path_X35 = Application.CurrentProject.Path & "\Gif_IMG" Path_X36 = Application.CurrentProject.Path & "\Fix_Photo" Path_X37 = Application.CurrentProject.Path & "\db_db_db_test_link" Path_X38 = Application.CurrentProject.Path & "\Corrupted_DBs" Path_X39 = Application.CurrentProject.Path & "\Corrupted_Archives" Path_X40 = Application.CurrentProject.Path & "\Change_Dy_Time_All_Table" Path_X41 = Application.CurrentProject.Path & "\Add Fonts.bmp" For Run = 0 To 40 If Run = 0 Then ' تنظيف المسار folderPath = Trim(Path_X0) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 1 Then ' تنظيف المسار folderPath = Trim(Path_X1) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 2 Then ' تنظيف المسار folderPath = Trim(Path_X2) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 3 Then ' تنظيف المسار folderPath = Trim(Path_X3) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 4 Then ' تنظيف المسار folderPath = Trim(Path_X4) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 5 Then ' تنظيف المسار folderPath = Trim(Path_X5) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 6 Then ' تنظيف المسار folderPath = Trim(Path_X6) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 7 Then ' تنظيف المسار folderPath = Trim(Path_X7) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 8 Then ' تنظيف المسار folderPath = Trim(Path_X8) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 9 Then ' تنظيف المسار folderPath = Trim(Path_X9) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 10 Then ' تنظيف المسار folderPath = Trim(Path_X10) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 11 Then ' تنظيف المسار folderPath = Trim(Path_X11) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 12 Then ' تنظيف المسار folderPath = Trim(Path_X12) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 13 Then ' تنظيف المسار folderPath = Trim(Path_X13) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 14 Then ' تنظيف المسار folderPath = Trim(Path_X14) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 15 Then ' تنظيف المسار folderPath = Trim(Path_X15) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 16 Then ' تنظيف المسار folderPath = Trim(Path_X16) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 17 Then ' تنظيف المسار folderPath = Trim(Path_X17) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 18 Then ' تنظيف المسار folderPath = Trim(Path_X18) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 19 Then ' تنظيف المسار folderPath = Trim(Path_X19) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 20 Then ' تنظيف المسار folderPath = Trim(Path_X20) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 21 Then ' تنظيف المسار folderPath = Trim(Path_X21) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 22 Then ' تنظيف المسار folderPath = Trim(Path_X22) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 23 Then ' تنظيف المسار folderPath = Trim(Path_X23) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 24 Then ' تنظيف المسار folderPath = Trim(Path_X24) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 25 Then ' تنظيف المسار folderPath = Trim(Path_X25) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 26 Then ' تنظيف المسار folderPath = Trim(Path_X26) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 27 Then ' تنظيف المسار folderPath = Trim(Path_X27) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 28 Then ' تنظيف المسار folderPath = Trim(Path_X28) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 29 Then ' تنظيف المسار folderPath = Trim(Path_X29) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 30 Then ' تنظيف المسار folderPath = Trim(Path_X30) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 31 Then ' تنظيف المسار folderPath = Trim(Path_X31) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 32 Then ' تنظيف المسار folderPath = Trim(Path_X32) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 33 Then ' تنظيف المسار folderPath = Trim(Path_X33) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 34 Then ' تنظيف المسار folderPath = Trim(Path_X34) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 35 Then ' تنظيف المسار folderPath = Trim(Path_X35) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 36 Then ' تنظيف المسار folderPath = Trim(Path_X36) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 37 Then ' تنظيف المسار folderPath = Trim(Path_X37) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 38 Then ' تنظيف المسار folderPath = Trim(Path_X38) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 39 Then ' تنظيف المسار folderPath = Trim(Path_X39) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 40 Then ' تنظيف المسار folderPath = Trim(Path_X40) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If If Run = 41 Then ' تنظيف المسار folderPath = Trim(Path_X41) If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\" ' إظهار المجلد result = SetFileAttributes(folderPath, FILE_ATTRIBUTE_NORMAL) If result <> 0 Then Me.lblStatus.Caption = "تم إظهار المجلد بنجاح: " & folderPath Me.lblStatus.ForeColor = vbGreen Else Me.lblStatus.Caption = "فشل في إظهار المجلد أو غير مخفي أساساً!" Me.lblStatus.ForeColor = vbRed End If End If Next Exit Sub ErrorHandler: Me.lblStatus.Caption = "حدث خطأ: " & err.Description Me.lblStatus.ForeColor = vbRed End Sub ما رايك في الفكرة 😇 @منتصر الانسي