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

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

طبعا تم تغيير كبير في الملف وهذا لازم لتقليل حجم الملف ولتطبيق وتنفيذ مطلوبك تم حدف ورقة من الأوراق , ليس لها لزمة تم فك الدمج عن بعض الأسطر والاعمدة والأن قم بتغيير القيمة في الخلية الكحلية (الفصول 1 - 3) حيث أنها تحتوي على قائمة منسدلة واختر التاريخ المطلوب وانظر للنتيجة باقي حاجة أنا نسيت المعادلات في أسفل الورقة ممكت تكتبهم من جديد المشكلة الأن : لو كان عدد الغائبين في الفصل الواحد أكثر من 10 فهذا الحل سيأتي بالعشرة فقط الغياب2.xls

تفضل اضغط على زر استدعاء في البحث ولاحظ النتيجة الغياب1.xls

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٪ وفي مثالنا السابق تستطيع من خلال بوت تيليجرام من خلال رسالة نصية او صوتية مثلا ان تتحكم بملف الاكسيل من حذف واضافة وتعديل ثم ارسال الملف الى البريد الاكتروني اذا كان هناك اهتمام من الاعضاء ساقوم بشرح وافي عنهما

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

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

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

وعليكم السلام ورحمة الله وبركاته ,, هذا يعني انه يمكن ان يكون المعيار مختلفاً !!!! طيب ، أمامك حلين اثنين في الوقت الحالي .. الأول من خلال معادلات مع الإستعانة بخلية ( عمود مساعد ) . وسيكون الحل كالآتي :- سنجعل المعايير متغيره بحيث يتم ادخال عدد الذكور والإناث وعدد القاعات في الخلايا ( 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

انظر الاستعلام SALESQT قمت بحذف الحقلين وممكن تستخدم عبارة تعبير Expression كما في الصورة

دالة InStr من أهم وأقوى الدوال المستخدمة في التعامل مع السلاسل النصية تستخدم لتحديد موضع أول ظهور لسلسلة فرعية داخل سلسلة نصية أخرى يمكن الاعتماد عليها في التحقق من وجود رموز أو مقاطع نصية داخل محتوى مثل: التحقق من وجود امتداد ملف البحث عن كلمة في اسم ملف فحص تنسيقات أو كجزء من معالجة متقدمة للنصوص الشكل العام: InStr(Start, String1, String2 , Compare) شرح المعاملات: Start (اختياري): >>---> رقم الموضع الذي تبدأ منه عملية البحث في String1 (يبدأ من 1) String1: >>---> السلسلة الأساسية التي يتم البحث بداخلها String2: >>---> السلسلة الفرعية المطلوب العثور عليها Compare (اختياري): >>---> نوع المقارنة يمكن استخدام: vbBinaryCompare (افتراضي): مقارنة حساسة لحالة الأحرف vbTextCompare : مقارنة تتجاهل حالة الأحرف الناتج: ترجع الدالة رقم موضع أول تطابق (Starting from 1) أو 0 إذا لم يتم العثور على أي تطابق أمثلة توضيحية شاملة 1- اختبار حالات مختلفة للدالة InStr Dim strText As String Dim strSearch As String Dim intStart As Integer Dim intResult As Integer ' البحث عن أول ظهور للحرف "a" strText = "Mohesam" strSearch = "a" intStart = 1 intResult = InStr(intStart, strText, strSearch) 'M o h e s a m '1 2 3 4 5 6 7 Debug.Print "الحالة 1: InStr(" & intStart & ", """ & strText & """, """ & strSearch & """) = " & intResult ' البحث من موقع مختلف intStart = 4 intResult = InStr(intStart, strText, strSearch) Debug.Print "الحالة 2: InStr(" & intStart & ", """ & strText & """, """ & strSearch & """) = " & intResult ' البحث عن حرف غير موجود strSearch = "z" intStart = 1 intResult = InStr(intStart, strText, strSearch) Debug.Print "الحالة 3: InStr(" & intStart & ", """ & strText & """, """ & strSearch & """) = " & intResult ' البحث في نص فارغ strText = "" strSearch = "a" intResult = InStr(1, strText, strSearch) Debug.Print "الحالة 4: InStr(1, """ & strText & """, """ & strSearch & """) = " & intResult ' البحث عن كلمة داخل جملة strText = "Access VBA" strSearch = "VBA" intResult = InStr(1, strText, strSearch) Debug.Print "الحالة 5: InStr(1, """ & strText & """, """ & strSearch & """) = " & intResult ' البحث المتكرر لنفس الكلمة strText = "abcabcabc" strSearch = "abc" intResult = InStr(1, strText, strSearch) Debug.Print "الحالة 6: InStr(1, """ & strText & """, """ & strSearch & """) = " & intResult ' البحث من منتصف السلسلة intResult = InStr(5, strText, strSearch) Debug.Print "الحالة 7: InStr(5, """ & strText & """, """ & strSearch & """) = " & intResult ' البحث مع اختلاف حالة الأحرف strText = "TestCase" strSearch = "case" intResult = InStr(1, strText, strSearch) Debug.Print "الحالة 8: InStr(1, """ & strText & """, """ & strSearch & """) = " & intResult & " (Compare = Binary افتراضي)" ' استخدام vbTextCompare لتجاهل حالة الأحرف intResult = InStr(1, strText, strSearch, vbTextCompare) Debug.Print "الحالة 9: InStr(1, """ & strText & """, """ & strSearch & """, vbTextCompare) = " & intResult Public Sub TestInStrFunction() Dim strText As String Dim strSearch As String Dim intStart As Integer Dim intResult As Integer Debug.Print String(70, "=") Debug.Print "اختبار دالة InStr" Debug.Print String(70, "=") ' الحالة 1: البحث عن حرف موجود من البداية strText = "Mohesam" strSearch = "a" intStart = 1 intResult = InStr(intStart, strText, strSearch) Debug.Print "الحالة 1: InStr(" & intStart & ", """ & strText & """, """ & strSearch & """) = " & intResult ' الحالة 2: البحث بعد الموضع الابتدائي intStart = 4 intResult = InStr(intStart, strText, strSearch) Debug.Print "الحالة 2: InStr(" & intStart & ", """ & strText & """, """ & strSearch & """) = " & intResult ' الحالة 3: البحث عن حرف غير موجود strSearch = "z" intStart = 1 intResult = InStr(intStart, strText, strSearch) Debug.Print "الحالة 3: InStr(" & intStart & ", """ & strText & """, """ & strSearch & """) = " & intResult ' الحالة 4: سلسلة فارغة strText = "" strSearch = "a" intResult = InStr(1, strText, strSearch) Debug.Print "الحالة 4: InStr(1, """ & strText & """, """ & strSearch & """) = " & intResult ' الحالة 5: البحث عن كلمة كاملة strText = "Access VBA" strSearch = "VBA" intResult = InStr(1, strText, strSearch) Debug.Print "الحالة 5: InStr(1, """ & strText & """, """ & strSearch & """) = " & intResult ' الحالة 6: البحث عن نفس الكلمة مكررة strText = "abcabcabc" strSearch = "abc" intResult = InStr(1, strText, strSearch) Debug.Print "الحالة 6: InStr(1, """ & strText & """, """ & strSearch & """) = " & intResult ' الحالة 7: بدء البحث من منتصف النص intResult = InStr(5, strText, strSearch) Debug.Print "الحالة 7: InStr(5, """ & strText & """, """ & strSearch & """) = " & intResult ' الحالة 8: حساس لحالة الأحرف strText = "TestCase" strSearch = "case" intResult = InStr(1, strText, strSearch) Debug.Print "الحالة 8: InStr(1, """ & strText & """, """ & strSearch & """) = " & intResult & " (Compare = Binary افتراضي)" ' الحالة 9: تجاهل حالة الأحرف باستخدام vbTextCompare intResult = InStr(1, strText, strSearch, vbTextCompare) Debug.Print "الحالة 9: InStr(1, """ & strText & """, """ & strSearch & """, vbTextCompare) = " & intResult End Sub 2- ملخص سريع مباشر للحالات Public Sub TestInStrCases() Debug.Print "==================================================" Debug.Print "اختبار دالة InStr" Debug.Print "==================================================" Debug.Print "الحالة 1: InStr(1, ""Mohesam"", ""a"") = "; InStr(1, "Mohesam", "a") Debug.Print "الحالة 2: InStr(4, ""Mohesam"", ""a"") = "; InStr(4, "Mohesam", "a") Debug.Print "الحالة 3: InStr(1, ""Mohesam"", ""z"") = "; InStr(1, "Mohesam", "z") Debug.Print "الحالة 4: InStr(1, """", ""a"") = "; InStr(1, "", "a") Debug.Print "الحالة 5: InStr(1, ""Access VBA"", ""VBA"") = "; InStr(1, "Access VBA", "VBA") Debug.Print "الحالة 6: InStr(1, ""abcabcabc"", ""abc"") = "; InStr(1, "abcabcabc", "abc") Debug.Print "الحالة 7: InStr(5, ""abcabcabc"", ""abc"") = "; InStr(5, "abcabcabc", "abc") Debug.Print "الحالة 8: InStr(1, ""TestCase"", ""case"") = "; InStr(1, "TestCase", "case") Debug.Print "الحالة 9: InStr(1, ""TestCase"", ""case"", vbTextCompare) = "; InStr(1, "TestCase", "case", vbTextCompare) Debug.Print "==================================================" End Sub استخدام احترافي البحث عن رموز داخل نص دالة InStr يمكن توظيفها داخل دوال أكثر تقدما للبحث عن مجموعة من الرموز داخل نص معين Public Function GetSymbolsInText(ByVal strText As String, ByVal arrSymbols As Variant, ByRef arrFound() As String) As Boolean Dim varSymbol As Variant Dim colFound As Collection Set colFound = New Collection ' البحث عن كل رمز في النص For Each varSymbol In arrSymbols If InStr(strText, varSymbol) > 0 Then On Error Resume Next ' لتجنب تكرار العناصر في المجموعة colFound.Add varSymbol, CStr(varSymbol) On Error GoTo 0 End If Next ' تجهيز النتائج النهائية If colFound.Count > 0 Then ReDim arrFound(0 To colFound.Count - 1) Dim i As Long For i = 1 To colFound.Count arrFound(i - 1) = colFound(i) Next i GetSymbolsInText = True Else ReDim arrFound(-1 To -1) GetSymbolsInText = False End If End Function تجربة هذه الدالة Public Sub TestGetSymbolsInText() Dim arrSymbols As Variant Dim arrFound() As String Dim bolFound As Boolean Dim strTest As String arrSymbols = Array(",", ";", "|", "/", "\", "-", "_") strTest = "Mohesam-2025/Report_Aug" ' تنفيذ البحث bolFound = GetSymbolsInText(strTest, arrSymbols, arrFound) ' عرض النتائج If bolFound Then Debug.Print "تم العثور على الرموز التالية:" Dim i As Long For i = LBound(arrFound) To UBound(arrFound) Debug.Print arrFound(i) Next i Else Debug.Print "لا يوجد أي رمز" End If End Sub Sub TestTextCompareBehavior() Dim str1 As String Dim str2 As String str1 = "Access" str2 = "access" ' المقارنة الثنائية (تراعي حالة الأحرف) ' - لن تنجح Debug.Print "BinaryCompare: "; InStr(1, str1, str2, vbBinaryCompare) ' المقارنة النصية (تتجاهل حالة الأحرف) ' - ستنجح Debug.Print "TextCompare: "; InStr(1, str1, str2, vbTextCompare) End Sub الكود السابق يوضح الفرق بين نمطي المقارنة في دالة InStr vbBinaryCompare: يقارن مع مراعاة حالة الأحرف (case-sensitive) vbTextCompare: يقارن بدون مراعاة حالة الأحرف (case-insensitive) النتيجة 0 في المقارنة الثنائية تعني أن "access" لم يتم العثور عليها داخل "Access" بسبب اختلاف حالة الحروف أما في TextCompare فتم العثور على "access" في بداية "Access" لأن الحالة تم تجاهلها المعامل الرابع في InStr InStr(Start, String1, String2 , Compare) إذا لم يتم تحديد CompareMethod فإن Access يستخدم الإعداد الافتراضي (غالبا vbBinaryCompare) لذلك ينصح دائما بتحديد نوع المقارنة صراحة لتفادي النتائج غير المتوقعة خاصة عند تجاهل حالة الأحرف الخلاصــــــــــة InStr تعيد موضع أول ظهور لسلسلة داخل سلسلة أخرى (يبدأ من 1) تعيد 0 إذا لم يتم العثور على تطابق يمكن تخصيص نوع المقارنة باستخدام المعامل الرابع مفيدة لبناء دوال متقدمة لمعالجة النصوص والرموز لتجاهل حالة الأحرف استخدم vbTextCompare لا تعتمد على القيمة الافتراضية في Compare حددها دائما لتفادي النتائج غير المتوقعة هناك دالة مكملة لـ InStr تسمى InStrRev تقوم بالبحث من نهاية النص إلى بدايته قد تكون مفيدة جدا في بعض الحالات (مثل البحث عن آخر امتداد أو آخر فاصل) InStr(1, "file.name.txt", ".") ' 5 InStrRev("file.name.txt", ".") ' 10 بكده الشرح انتهى ولتحقيق اكبر قدر ممكن من الاستفادة وفيما يخص النقطة التالية: مفيدة لبناء دوال متقدمة لمعالجة النصوص والرموز دى فكرة كود داخل وحدة نمطية عامة فى الاعتماد على كل من InStr , InStrRev اتركها لكم للاستمتاع بها Option Compare Database Option Explicit Public Enum TextCase AsIs = 0 ' كما هو Lower = 1 ' أحرف صغيرة Upper = 2 ' أحرف كبيرة Proper = 3 ' أول حرف كبير End Enum ' تعريفات الأنواع Public Enum FilePartType FileNameWithExtension ' اسم الملف مع الامتداد FileNameOnly ' اسم الملف بدون الامتداد FileExtensionOnly ' الامتداد بدون النقطة FileExtensionWithDot ' الامتداد مع النقطة FullFolderPath ' المسار الكامل للمجلد ContainingFolderName ' اسم المجلد الحاوي فقط RootDrive ' الجذر (مثل C:\ أو اسم السيرفر) VersionOnly ' الإصدار فقط (مثل v1.2) DateOnly ' التاريخ فقط (مثل 2025-07-17) FullUNCPath ' المسار الكامل بصيغة UNC FileURL ' المسار بصيغة URL FileNameWithoutVersionOrDate ' اسم الملف بدون الإصدار أو التاريخ ServerAndShare ' السيرفر والمشاركة من مسار UNC End Enum ' كائنات على مستوى الوحدة لتحسين الأداء Private objFSO As Object Private objRegEx As Object ' الدالة الرئيسية لاستخراج أجزاء المسار Public Function ExtractFilePartPro( _ ByVal strPath As String, _ Optional ByVal enmPart As FilePartType = FileNameWithExtension, _ Optional ByVal enuTextCase As TextCase = AsIs, _ Optional ByRef strVersion As String = "", _ Optional ByRef strDate As String = "", _ Optional ByRef strError As String = "" _ ) As String Dim strResult As String Dim lngPos As Long Dim strFileName As String Dim strFolder As String Dim strExt As String Dim strParent As String Dim colMatches As Object Dim vMatch As Variant ' تهيئة رسالة الخطأ إلى فارغة strError = "" ' إنشاء الكائنات إذا لم تكن موجودة If objFSO Is Nothing Then Set objFSO = CreateObject("Scripting.FileSystemObject") If objRegEx Is Nothing Then Set objRegEx = CreateObject("VBScript.RegExp") With objRegEx .Global = True .IgnoreCase = True ' نمط محسن لدعم إصدارات مع أحرف وتواريخ بصيغ مختلفة .Pattern = "(v[\d\.]+[a-zA-Z-]*)|((?:19|20)\d{2}[-_/]?\d{2}[-_/]?\d{2}|\d{8})" End With End If On Error GoTo ErrHandler ' تنظيف المسار strPath = Trim(strPath) ' التحقق من المسار الفارغ If strPath = "" Then strError = "المسار فارغ" ExtractFilePartPro = "" Exit Function End If ' استخراج اسم الملف If objFSO.FileExists(strPath) Or InStrRev(strPath, "\") > 0 Then strFileName = Mid(strPath, InStrRev(strPath, "\") + 1) Else strFileName = strPath End If ' استخراج المسار الكامل للمجلد strFolder = Left(strPath, Len(strPath) - Len(strFileName)) ' استخراج الامتداد (يدعم الامتدادات المركبة مثل .tar.gz) If InStr(strFileName, ".") > 0 Then lngPos = InStrRev(strFileName, ".") strExt = Mid(strFileName, lngPos) If LCase(strExt) = ".gz" And InStrRev(strFileName, ".tar.gz") > 0 Then strExt = ".tar.gz" End If Else strExt = "" End If ' استخراج اسم المجلد الحاوي If Right(strFolder, 1) = "\" Then strFolder = Left(strFolder, Len(strFolder) - 1) If InStrRev(strFolder, "\") > 0 Then strParent = Mid(strFolder, InStrRev(strFolder, "\") + 1) Else strParent = "" End If ' استخراج الإصدار والتاريخ باستخدام RegExp If objRegEx.Test(strFileName) Then Set colMatches = objRegEx.Execute(strFileName) For Each vMatch In colMatches If Left(LCase(vMatch), 1) = "v" Then strVersion = vMatch Else strDate = vMatch End If Next End If ' اختيار الجزء المطلوب Select Case enmPart Case FileNameWithExtension strResult = strFileName Case FileNameOnly If strExt <> "" Then strResult = Left(strFileName, Len(strFileName) - Len(strExt)) Else strResult = strFileName End If Case FileExtensionOnly If strExt <> "" Then strResult = Mid(strExt, 2) Case FileExtensionWithDot strResult = strExt Case FullFolderPath strResult = strFolder Case ContainingFolderName strResult = strParent Case RootDrive If Left(strPath, 2) = "\\" Then strResult = Split(strPath, "\")(2) ' اسم السيرفر فقط Else strResult = Left(strPath, 3) End If Case VersionOnly strResult = strVersion Case DateOnly strResult = strDate Case FullUNCPath strResult = strPath Case FileURL If Left(strPath, 2) = "\\" Then strResult = "file://" & Replace(strPath, "\", "/") Else strResult = "file:///" & Replace(strPath, "\", "/") End If Case FileNameWithoutVersionOrDate strResult = objRegEx.Replace(strFileName, "") Case ServerAndShare If Left(strPath, 2) = "\\" Then Dim arrParts As Variant arrParts = Split(strPath, "\") If UBound(arrParts) >= 3 Then strResult = "\\" & arrParts(2) & "\" & arrParts(3) Else strResult = "" End If Else strResult = "" End If End Select ' تنسيق النص حسب الخيار المحدد Select Case enuTextCase Case Lower strResult = LCase(strResult) Case Upper strResult = UCase(strResult) Case Proper strResult = StrConv(strResult, vbProperCase) Case Else ' AsIs, لا تغيير End Select ExtractFilePartPro = strResult ExitHere: Set colMatches = Nothing Exit Function ErrHandler: strError = "خطأ: " & Err.Description ExtractFilePartPro = "" Resume ExitHere End Function ' روتين اختبار موسع Public Sub TestEnhanced() Dim strPath As String Dim strUNCPath As String Dim strResPath As String Dim strRes As String Dim strVer As String Dim strDat As String Dim strError As String ' تعيين مسارات الاختبار strPath = "C:\Test\MyDataBase\Officena.Accdb" strUNCPath = "\\Server\Myhiba\Officena.Accdb" strResPath = "C:\Test\MyFile_v3.4_2025-07-17.tar.gz" Debug.Print String(70, "=") Debug.Print "اختبارات استخراج أجزاء المسار" Debug.Print String(70, "=") ' اختبار الأجزاء الأساسية Debug.Print "اختبار الأجزاء الأساسية" Debug.Print String(70, "-") Debug.Print " الاسم مع الامتداد : " & ExtractFilePartPro(strPath, FileNameWithExtension) Debug.Print " الاسم فقط : " & ExtractFilePartPro(strPath, FileNameOnly) Debug.Print " الامتداد فقط : " & ExtractFilePartPro(strPath, FileExtensionOnly) Debug.Print " الامتداد مع النقطة : " & ExtractFilePartPro(strPath, FileExtensionWithDot) Debug.Print " اسم المجلد الحاوي : " & ExtractFilePartPro(strPath, ContainingFolderName) Debug.Print " المسار بدون اسم الملف : " & ExtractFilePartPro(strPath, FullFolderPath) Debug.Print " الجذر : " & ExtractFilePartPro(strPath, RootDrive) Debug.Print " المسار بصيغة UNC : " & ExtractFilePartPro(strUNCPath, FullUNCPath) Debug.Print " المسار بصيغة URL : " & ExtractFilePartPro(strUNCPath, FileURL) Debug.Print String(70, "-") ' اختبار استخراج الإصدار والتاريخ strRes = ExtractFilePartPro(strResPath, FileNameOnly, AsIs, strVer, strDat) Debug.Print "اختبار استخراج الإصدار والتاريخ" Debug.Print " الاسم : " & strRes Debug.Print " الإصدار : " & strVer Debug.Print " التاريخ : " & strDat ' اختبار الخيارات الجديدة Debug.Print " FileNameWithoutVersionOrDate: " & ExtractFilePartPro(strResPath, FileNameWithoutVersionOrDate) Debug.Print " ServerAndShare : " & ExtractFilePartPro(strUNCPath, ServerAndShare) ' اختبار معالجة الأخطاء strRes = ExtractFilePartPro("", FileNameWithExtension, AsIs, , , strError) Debug.Print " Empty path result : " & strRes & ", Error: " & strError strRes = ExtractFilePartPro("C:\Invalid\Path", FileNameWithExtension, AsIs, , , strError) Debug.Print " Invalid path result : " & strRes & ", Error: " & strError ' اختبار تنسيق الحروف Debug.Print " Upper case : " & ExtractFilePartPro(strPath, FileNameWithExtension, Upper) Debug.Print "======================================================" End Sub

وعليكم السلام ورحمة الله وبركاته .. تستطيع ذلك من خلال ملفك المرفق كالآتي :- في الخلية B5 ( لحساب الأيام ) :- =MOD(B3+B4,30) في الخلية C5 ( لحساب الأشهر ) :- =MOD(C3+C4+QUOTIENT(B3+B4,30),12) في الخلية D5 ( لحساب السنوات ) :- =D3+D4+QUOTIENT(C3+C4+QUOTIENT(B3+B4,30),12) وتستطيع أيضاً عرض التفصيل كاملاً في خلية واحدة . على سبيل المثال . قمت بدمج الخلايا B+C+D = 6 في خلية واحدة ، وأدرجت فيها المعادلة التالية :- =D3+D4+QUOTIENT(C3+C4+QUOTIENT(B3+B4,30),12) & " سنوات, " & MOD(C3+C4+QUOTIENT(B3+B4,30),12) & " أشهر, " & MOD(B3+B4,30) & " أيام" وهذه صورة من النتيجة النهائية :- Number of Serveces.zip

أخواني وأساتذتي ومعلمينا ( دون استثناء ) أعتقد أنه ومن خلال العنوان سيتسائل البعض عن أن المحاولات كانت كثيرة لبناء هذه الفكرة ولكنها مع التحديثات الجديدة تفشل !! وهذا الإعتقاد منطقي 😁 . إلا انه وبهذه التحديثات - واتمنى - أنه قد تم التعامل مع هذه الأخطاء بهذه النسخة المطورة والمحسنة . الإضافات التي تم تأمينها في هذه النسخة :- التعامل مع المرفقات بسلاسة وسهولة من خلال فكرة نسخ المرفق ولصقه في تطبيق الواتس اب ( سطح المكتب ) ، وليس من خلال المسار 😁 . إمكانية الإرسال لأكثر من رقم دفعة واحدة . افصل بين الرقمين بإشارة / فقط . إمكانية إضافة التعبيرات Emoji وإرسالها ضمن الرسائل في الواتس أب . من خلال زر زر لمسح محتوى الرسالة تهيئةً لإرسال جديد . من خلال الزر تضمين محدد لحجم الملفات والمرفقات المرسلة . ( خاص بأصحاب التطويرات الذين يريدون تقييد وإلزام المستخدم بحجم محدد ) . استخدام تايمر متغير للتعامل مع الإرسالات المتعددة لأكثر من رقم . واجهة محاكية وجذابة للبرنامج . لا تحتاج جداول أو مكتبات خارجية .... إلخ . تم كتابة الدوال والأكواد بطريقة تسهل على المطورين إعادة الهيكلة والتصميم حسب حاجتهم في برامجهم . واجهة البرنامج :- :- ضرورة تثبيت برنامج واتس اب سطح المكتب من متجر ويندوز . التأكد من فتح تطبيق الواتس أب سطح المكتب لديك ، لتلافي المشاكل عند اختلاف سرعة إستجابة الكمبيوتر من مستخدم لآخر . WhatsApp Sender 2025.zip التحديث الجديد من مرسال الواتس أب - الإصدار الثاني . يحتوي على الإضافات والتحسينات التالية :- 1️⃣ التحسينات :- تحسين التعامل مع المرفقات الأكثر من مرفق واحد ، بحيث يتم التعامل معها دفعة واحدة بدلاً من التعامل مع كل مرفق بشكل مستقل ( تقليل الوقت ) . تحسين عمليات المحاكاة للوحة المفاتيح للصق الرسالة والملفات داخل تطبيق واتس أب سطح المكتب . 2️⃣ الإضافات الجديدة :- إنشاء جداول الخدمة ( عددها 3 ) بشكل تلقائي . إضافة ميزة الإستيراد من ملفات VCF ( النسخة الإحتياطية من قائمة الأسماء من الجوال ) . بحيث يتم استيراد الأرقام والأسماء الى جدول Tbl_Contacts ، من خلال زر ، مع دعم التعامل مع الترميزات والتشفيرات المختلفة . وأيضاً الأرقام يتم تحويلها إلى صيغة دولية تلقائيًا (مثلاً: 079xxxx → +96279xxxx) . إضافة ميزة إنشاء جهة اتصال جديدة ( قيد التطوير للأفضل ) ، من خلال الزر . إضافة ميزة "إرفاق التوقيع مع الرسالة" . ويمكن التحكم بها من خلال جدول الإعدادات Tbl_SendSettings . إضافة ميزة الإرسال من دفتر العناوين ( متعدد الإختيار ) ، أو ادخال رقم هاتف بشكل يدوي . عند ادخال رقم هاتف يدوي ( محلي ) بدون مفتاح الدولة ، يتم قراءة قيمة رمز الدولة الإفتراضي من الجدول Tbl_SendSettings الخاص بالإعدادات . وعليه فسلت بحاجة لإضافة مفتاح الدولة المحلية بشكل يدوي وإلزامي . إضافة ميزة تقييد مفتاح الإيموجي من خلال جدول الإعدادات . فمنح أو رفض الصلاحية بالوصول اليه . ( قيد التطوير بحيث يتم المنع حتى من خلال لوحة المفاتيح ) . إضافة ميزة تحديد أنواع الملفات المسموح للمستخدم بإرسالها في جدول الإعدادات نفسه . إضاقة التحكم بفترة الإنتظار بين الرسالتين عند الإرسال المتعدد ( بالثواني - القيمة الإفتراضية = 2 ) . إضافة ميزة التحكم بالحد الأقصى لحجم الملفات المرفقة ( فردي أو أكثر من مرفق ) من خلال جدول الإعدادات أيضاً . إضافة رابط لتحميل نسخة برنامج واتس أب سطح المكتب من مصدره على موقع Whatsapp ، من خلال الزر . إضافة ميزة الحفظ التلقائي للأرقام الغير مخزنة في دليل الهاتف ( الجدول Tbl_Contacts ) . بحيث يتم تعريف الرقم بأنه "غير معروف" . وفي التعديلات اللاحقة سيتم إضافة ميزات لها . جميع الرسائل المرسلة ( الناجحة والغير ناجحة ) سيتم تخزينها في الجدول Tbl_Message . أيضاً في التعديلات اللاحقة سيتم إضافة ميزات لها . :- دعوة لتجربة الإستيراد من ملفات الـ VCF ، وإخباري بالنتيجة عن مدى صحة الإستيراد . السبب في سؤالي هذا هو اختلاف إصدارات هذه الملفات الناتجة عن اختلاف إصدارات أنظمة التشغيل في الهاتف الخلوي ، أو اختلاف الحصول عليها حسب البرنامج . وللعلم الـ VCF هي ملفات تستخدم لتخزين معلومات جهات الاتصال . كيف نحصل عليها :- في الأندرويد : الذهاب إلى تطبيق جهات الاتصال ثم الإعدادات ثم ابحث عن استيراد و تصدير جهات الإتصال ثم حفظ كملف VCF . في الآيفون : لا يدعم آيفون هذه الميزة ( تصدير جهات الإتصال ) إلا من خلال تطبيقات كمبيوتر مثل 3UTools وشبيهاته . 3️⃣ صور الواجهة الجديدة :- 4️⃣ تحميل الإصدار الجديد :- WhatsApp Sender 2025 V2.0.zip 😬 يوجد سطر لم أقم بحذفه سهواً أثناء التعديلات في دالة الإستيراد الرئيسية من المديول في الدالة Public Function ImportVCF . السطر :- Forms("Frm_Sender").Controls("Text0").Requery حيث أن هذا العنصر تم الإستغناء عنه . ومرفق في طيه ملف VCF تجريبي للتجربة Test VCF.zip

الجزء الثاني التحكم بملف الاكسل عن mcp server رابط الجزء الثاني

فيديو تعريفي رابط يوتيوب

وفقنا الله جميعا للخير أنا شخصيا أفضل المعادلات حتى يمكن عرض الملف في جميع الأجهزة موبايل أو كمبيوتر أو ويب أما الأكواد فتحتاج إلى كمبيوتر وأوفيس تحياتي

الصراحة أن هذه المشكلة مثل المخدر الذي لا يستطيع الشخص الإقلاع عنا إلا بحلها وكلما قلت سأقلع عن التفكير فيها أرجع لها وبقوة توصلت أخيرا لدالة تحويل تشية دوال التحويل المضمنة (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 Const TABLE_NAME As String = "tblCalendarComponents" Private Const QUERY_NAME As String = "qryGenerateFullDates" Public Const DATE_TYPE_DAY As String = "DayType" Public Const DATE_TYPE_MONTH As String = "MonthType" Public Const DATE_TYPE_YEAR As String = "YearType" Public Const DefaultYearOffset As Long = 3 Public Const DefaultStartYear As Long = 0 Public Const DefaultYearCount As Long = 100 Public Const MIN_YEAR As Long = 1900 Public Const MAX_YEAR As Long = 2100 '' === TestGenerateDates Public Sub TestGenerateDates() ''--- سنة البدء (0 = القيمة الافتراضية) Dim lngStartYear As Long: lngStartYear = 0 ''--- فرق السنوات الافتراضي Dim lngOffset As Long: lngOffset = DefaultYearOffset ''--- عدد السنوات المراد توليدها Dim lngYearCount As Long: lngYearCount = 10 Call GenerateDates(lngStartYear, lngOffset, lngYearCount) End Sub '' ======= الإجراء الرئيسي لإنشاء الجدول والاستعلام ======= Public Sub GenerateDates( _ Optional ByVal StartYear As Long = 0, _ Optional ByVal YearOffset As Long = DefaultYearOffset, _ Optional ByVal YearCount As Long = DefaultYearCount) On Error GoTo ErrorHandler ' تعيين الفرق الافتراضي إن لم يُمرر If YearOffset = -1 Then YearOffset = DefaultYearOffset ' حساب سنة البدء إذا لم تُمرر If StartYear = 0 Then StartYear = Year(Date) - YearOffset ' التحقق من سنة البدء ضمن النطاق If StartYear < MIN_YEAR Or StartYear > MAX_YEAR Then Err.Raise vbObjectError + 1000, , "StartYear يجب أن يكون بين " & MIN_YEAR & " و " & MAX_YEAR End If ' التحقق من عدد السنوات ضمن النطاق If YearCount < 1 Or YearCount > (MAX_YEAR - StartYear + 1) Then Err.Raise vbObjectError + 1001, , "YearCount يجب أن يكون بين 1 و " & (MAX_YEAR - StartYear + 1) End If ' إنشاء الجدول والاستعلام Call PopulateDateTable(StartYear, YearCount) Call CreateOrUpdateDateGenerationQuery MsgBox "تم إنشاء الجدول والاستعلام بنجاح.", vbInformation, "نجاح العملية" Exit Sub ErrorHandler: MsgBox "حدث خطأ أثناء إنشاء الجدول أو الاستعلام:" & vbCrLf & _ "رقم الخطأ: " & Err.Number & vbCrLf & _ "الوصف: " & Err.Description, vbCritical, "خطأ" End Sub '' ======= ملء جدول التواريخ ======= Public Sub PopulateDateTable( _ Optional ByVal StartYear As Long = DefaultStartYear, _ Optional ByVal YearCount As Long = DefaultYearCount) On Error GoTo ErrorHandler Dim db As DAO.Database: Set db = CurrentDb ' حذف الجدول قبل الإنشاء On Error Resume Next db.TableDefs.Delete TABLE_NAME On Error GoTo ErrorHandler Call CreateDateTable(db) If StartYear = 0 Then StartYear = Year(Date) - DefaultYearOffset Dim i As Long For i = 1 To 31 db.Execute "INSERT INTO " & TABLE_NAME & " (DateNo, DateType) VALUES (" & i & ", '" & DATE_TYPE_DAY & "')", dbFailOnError Next i For i = 1 To 12 db.Execute "INSERT INTO " & TABLE_NAME & " (DateNo, DateType) VALUES (" & i & ", '" & DATE_TYPE_MONTH & "')", dbFailOnError Next i For i = 0 To YearCount - 1 db.Execute "INSERT INTO " & TABLE_NAME & " (DateNo, DateType) VALUES (" & StartYear + i & ", '" & DATE_TYPE_YEAR & "')", dbFailOnError Next i Set db = Nothing Exit Sub ErrorHandler: MsgBox " خطأ أثناء تعبئة الجدول: " & Err.Description, vbCritical End Sub '' ==== دالة لحساب الحد الأقصى لطول النص بين أنواع التاريخ Public Function GetMaxDateTypeLength() As Long Dim lngMaxLen As Long lngMaxLen = Len(DATE_TYPE_DAY) If Len(DATE_TYPE_MONTH) > lngMaxLen Then lngMaxLen = Len(DATE_TYPE_MONTH) If Len(DATE_TYPE_YEAR) > lngMaxLen Then lngMaxLen = Len(DATE_TYPE_YEAR) GetMaxDateTypeLength = lngMaxLen End Function '' ======= إنشاء الجدول مع الحقول والفهرسة ======= Private Sub CreateDateTable(db As DAO.Database) On Error Resume Next db.TableDefs.Delete TABLE_NAME On Error GoTo 0 Dim tdf As DAO.TableDef Set tdf = db.CreateTableDef(TABLE_NAME) With tdf '' حقل الترقيم التلقائي Dim fld As DAO.Field Set fld = .CreateField("ID", dbLong) fld.Attributes = dbAutoIncrField .Fields.Append fld '' حقل الرقم Set fld = .CreateField("DateNo", dbLong) fld.Required = True .Fields.Append fld '' نوع التاريخ Set fld = .CreateField("DateType", dbText, GetMaxDateTypeLength()) fld.Required = True .Fields.Append fld End With '' فهرس المفتاح الأساسي Dim idx As DAO.Index Set idx = tdf.CreateIndex("PrimaryKey") idx.Primary = True idx.Fields.Append idx.CreateField("ID") tdf.Indexes.Append idx '' فهرس فريد على التاريخ والنوع Set idx = tdf.CreateIndex("UniqueDateNoType") idx.Unique = True idx.Fields.Append idx.CreateField("DateNo") idx.Fields.Append idx.CreateField("DateType") tdf.Indexes.Append idx db.TableDefs.Append tdf Set fld = Nothing Set idx = Nothing Set tdf = Nothing End Sub '' ======= إنشاء أو تحديث الاستعلام لإنتاج كل التواريخ ======= Public Sub CreateOrUpdateDateGenerationQuery() On Error GoTo ErrorHandler Dim db As DAO.Database: Set db = CurrentDb Dim strSQL As String Dim qdf As DAO.QueryDef strSQL = "SELECT DateSerial(Years.DateNo, Months.DateNo, Days.DateNo) AS GeneratedDate " & _ "FROM " & TABLE_NAME & " AS Days, " & _ TABLE_NAME & " AS Months, " & _ TABLE_NAME & " AS Years " & _ "WHERE Days.DateType = '" & DATE_TYPE_DAY & "' " & _ "AND Months.DateType = '" & DATE_TYPE_MONTH & "' " & _ "AND Years.DateType = '" & DATE_TYPE_YEAR & "'" '' حذف الاستعلام لو موجود If QueryExists(QUERY_NAME) Then db.QueryDefs.Delete QUERY_NAME End If '' إنشاء الاستعلام Set qdf = db.CreateQueryDef(QUERY_NAME, strSQL) Application.RefreshDatabaseWindow Exit Sub ErrorHandler: MsgBox " خطأ أثناء إنشاء الاستعلام: " & Err.Description, vbCritical End Sub '' ======= التحقق من وجود جدول ======= Private Function TableExists(ByVal TableName As String) As Boolean On Error Resume Next TableExists = (Len(CurrentDb.TableDefs(TableName).Name) > 0) On Error GoTo 0 End Function '' ======= التحقق من وجود استعلام ======= Private Function QueryExists(ByVal QueryName As String) As Boolean On Error Resume Next QueryExists = (Len(CurrentDb.QueryDefs(QueryName).Name) > 0) On Error GoTo 0 End Function واخيرا يتم تعديل الاعدادت المناسبة لك و فقط يتم عمل كل شئ من تشغيل الإجراء التالى: TestGenerateDates

معذرة لتأخير بالمباركة لأني بكمل عمليات عينيا بمصر مبروك علينا وتمنياتي بالتوفيق دائما

جزيت خيرا اخي ناقل .. السطر يتحدث عن نفسه .. سوف اجربه انا حريص على عدم وجود ثغرات .. خاصة وان التاريخ عرضة للتغير بسبب تنسيقات وندوز ... عربي /انجليزي /ونظام 12 و 24 لذا اعتقد ان كلمة السر في كود ابي جودي هي هذا السطر : dtmTime = CDate(varDateTime)

جرب هذه الدالة IIf(Hour([chekin]) < 12, "الصباح", "المساء") لم اجربها ...

اقصد انها زائدة لا داعي لها حتى شرح الدالة هنا ادناه .. لا يوجد ما يفيد بوجود شرط يتبعها .. الشرط اختياري يكون في اول الدالة لتحديد مكان الحرف او الرقم المطلوب في الجملة فمنطقيا هي true عند وجود المطلوب و false عند عدمه ... وحسب طلب مثل طلبي ( يعتمد على علامة السالب.. وهي وحيدة دوما) .. لسنا بحاجة لمعرفة مكان الحرف الحمد .. سؤال بسيط .. كنت متوقع اجابة واحدة فقط ... انظروا كم من من الفؤائد المحصلة الف شكرا لكم اخوتي واحبتي على هذا التفاعل الايجابي .. جعله الله في موازين اعمالكم ، وغفر لنا ولكم ووالدينا ووالديكم .

ليه بس كذا .. 😔 الكود وحسب الشروحات اعلاه .. يقول .. ابحث .. يا موجود .. يا لا اذا موجود لبسه البشت

طالما نوع الحقل نصي فالحل بسيط أضفت تقرير لمثال الأخ @Foksh تظهر فيه القيم السالبة باللون الاحمر مع تحياتي TimeMin.rar

وعليكم السلام , هناك اسباب عديدة لثقل ملف الاكسل منها : كثرة المعادلات , كثرة الرسومات , كثرة التنسقات العادية والشرطية لو أنك ترسل ورقة واحدة من هذا الملف الثقيل لديك فيمكننا أن نكتشف بعض الحلول . تقبل تحياتي

مرفق لك مثالك بعد التعديل قمت بإضافة جدول tblDates والإستعلام qryDates النتيجة النهائية ستجدها في الاستعلام Query1 أرجو أن يكون هو ماتبحث عنه مع تحياتي Database1.rar

تجربة تم حذف المسافات والبحث بدالة VLOOKUP تجربة للرفع (2).xlsx

خلاااااص !! دلوقتي ارتحت ، وأقدر أنسحب بهوووووووووء وانام مرتاح البال والضمير

انت تقصد لاقيت نفسك فاضى قلت فى عقل بالك تعمل ايه تعمل ايه يا واد فؤش اه الواد او جودى هنا وعمال يخبط دماغه فى الحيط .. اسيبــه ؟! .... لا ... اروح اعمل له Error فى دماغه بزياده قبل ما يروح على شغله وبعدين ادخل انام عاش عليك يا فؤش خلاااااااااااااااااااص مباقاش فاضل تكـــــــــه بح خلاص على ايدك يا فؤش أفندى خلصت التكـه

انا عارف والله ان فكرتك أسرع من فكرتي لما يكون الفرق بين التاريخين كبير .. وعارف ان استخدامك للمصفوفة أفضل لأنه ببنيها مرة وحدة وبعدين يجمعها كلها مرة وحدة برضو ، على عكس فكرتي لأن السلسة التراكمية اللي استعملتها يتم بناءها كل مرة ,,, ، انا لقيت نفسي فاضي ، قلت أحاول أتعب دماغي شوية واحاول انام 😴

اذا الموضوع اسهل الان بوجود هذا الجدول المساعد مباشرة وبدون اى اكواد ممكن عمل الاستعلام التالى SELECT tbl1.user_id, tbl2.dateField FROM tbl1, tbl2 WHERE (((tbl2.dateField) Between [tbl1].[startA] And [tbl1].[endA])) ORDER BY tbl1.user_id, tbl2.dateField; ممكن الجدول المساعد tbl2 يتم عمل البيانات بداخله ديناميكا ليحتوى على كل تواريخ العام منذ بداية العام الى نهايته مثلا من خلال الكود التالى Public Sub PopulateDateTable(Optional ByVal dtmStartDate As Date = 0, Optional ByVal dtmEndDate As Date = 0) Dim db As DAO.Database Dim rs As DAO.Recordset Dim dtmDate As Date Dim lngYearNow As Long ' الحصول على السنة الحالية lngYearNow = Year(Date) ' تعيين القيم الافتراضية إذا لم يتم تمريرها If dtmStartDate = 0 Then dtmStartDate = DateSerial(lngYearNow, 1, 1) If dtmEndDate = 0 Then dtmEndDate = DateSerial(lngYearNow, 12, 31) ' التأكد أن التاريخين صالحين If dtmStartDate > dtmEndDate Then MsgBox "تاريخ البداية أكبر من تاريخ النهاية!", vbExclamation Exit Sub End If Set db = CurrentDb ' مسح البيانات القديمة db.Execute "DELETE FROM tbl2", dbFailOnError ' فتح الجدول للإضافة Set rs = db.OpenRecordset("tbl2", dbOpenDynaset) ' ملء السجلات For dtmDate = dtmStartDate To dtmEndDate rs.AddNew rs!dateField = dtmDate rs.Update Next dtmDate ' تنظيف الموارد rs.Close Set rs = Nothing Set db = Nothing MsgBox "تم توليد التواريخ من " & Format(dtmStartDate, "yyyy-mm-dd") & " إلى " & Format(dtmEndDate, "yyyy-mm-dd"), vbInformation End Sub

مباشرة بعد ردك الأول كنت سأشرح ما قاله الأستاذ جعفر بناءا على تجربتي الشخصية .. ولكن كفى الله المؤمنين القتال

تفضل برنامج تصميم سريع لعله يفي بالغرض أجازات 2.xlsm

حياكم الله ان شاء الله غدا ساعمل فيديو تعريفي مفصل وشرح موقع ottokit وهذا موقع حديث طبعا يفتقد الى كثير من المهارات لكن ميزته انه بدون اكواد تستطيع انشاء mcp server

. هناك عدة طرق للتعامل مع هذا التأخير: أ. يجب اعادة النظر في الاستعلام ، ومن متابعتي لردودك ، فأنت عندك هوس/ولع غير طبيعي في الكود ، بينما الاستعلام هو العمود الفقري لقواعد البيانات ، وهو الاسرع. فيجب النظر في تحويل الكود الى استعلامات ، وقد يكون عليك استبدال الكود الواحد الى استعلام واحد اثنين عشرة ... لا يهم ، المهم هو سرعة البرنامج ، ب. او تصدير نتائج هذا الاستعلام الى جدول ، ويكون الجدول هو مصدر بيانات النموذج/التقرير ، فالتأخير سيكون مرة واحدة فقط (عند تصدير الاستعلام ومعالجته الحسابات المعقدة ، الى الجدول) : بما ان الاكسس لا يستطيع عمل اكثر من شيء واحد في نفس الوقت ، اي انه ينتظر حتى تكتمل عمليه معينة ، حتى يقوم بعملية اخرى. مثلا ، اذا اردت عند فتح البرنامج ان يقوم اكسس بتصدير بيانات اسنعلامك البطئ الى جدول ، فعند نقرك زر التصدير ، فلا تستطيع عمل شيء آخر في الاكسس الى ان ينتهي العمل من التصدير ، لذا وبعد النقر على زر التصدير ، اظهر رسالة للمستخدم بترك البرنامج يعمل ، ولما ينتهي البرنامج من التصدير ، تستطيع استخدامه (اعطيه فرصة يشرب قهوة الصباح 🙂 ). الطريقة الاخرى ، والتي لن تجد احد يتكلم عنها (لأنها غير مألوفة) ، بأن تشغل برنامج اكسس آخر (رقم2) والذي فيه الاستعلام البطئ ، فيشغل الاستعلام بأخذ بياناته من برنامجك ، وتصدير البيانات الى جدول ، وفي هذا الوقت وبينما يعمل رقم2 ، يستطيع مستخدمين رقم1 من العمل بطريقة عادية ، ثم يستعملون بيانات الجدول. بمعنى آخر ، اجعل البرامج تشتغل بطريقة متوازية. ولكني اعتقد ان حل التأخير في النقطة أ. وبعد اتباع الطريقة الصحيحة في عمل الاستعلام ، معظم تأخير الاستعلامات هي في الفرز والتصفية ، وحتى اذا عملت فهرسة لحقل ثم في الاستعلام استعملت بيانات الحقل بطريقة اخرى ، فانت في الواقع لا تستفيد من فهرست الحقل ، مثلا عندك حقل تاريخ مفهرس myDate ، ثم قمت في الاستعلام بطلب السنة: Y: Year([myDate]) وعملت له فرز او تصفية لسنة معينة (مثلا 2010) ، فانت في الواقع لا تستفيد من فهرست الحقل ، لذا فالحل هو استعمالك التاريخ كما هو في الحقل ثم عمل التصفية بنفس طريقته ، مثل: myDate>31-12-2009 and myDate<1-1-2011 بكلام آخر ، اعرض الحقول في الاستعلام كما هي في الجدول ، فترى سرعة عرض الاستعلام لبياناته ، واحفظ هذا الاستعلام للرجوع اليه كمصدر لمقارنة سرعتة بالاستعلامات الاخرى ، ثم وفي نسخة اخرى منه ، ابدأ بإضافة حقل واحد (سواء حقل معادلة ، او فرز او تصفية) وابدأ بالامور السهلة ، فاذا لاحظت بطئ في الاستعلام ، فيجب معالجتها ثم الانتقال الى الحقل الآخر ، وهكذا. وكلمة اخيرة ، فالاكسس عنده امكانيات معينة ونقاط ضعف ، ولا يمكنك دائما التغلب على نقاط الضعف.

السلام عليكم انا فخور أن مشاركاتي الطويلة يتم قراءتها ويُستفاد منها 🙂 انا دائما انظر لعملي ، انه بعد 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

انا عجبتنى الافكار بس اضفت بعض البهارات للطبخة اتمنى لكم مذاقا هنيئا 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

اما اذا اردنا استعمال 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

والخبر الجيد بحكم تجربتي مع استيراد بيانات من جوجل شيت الى جداول اكسيس نعم ، يمكنك تحويل الملف إلى Google Sheets واستبدال أكواد VBA بـ Google Apps Script (لغة برمجة مختلفة) طبعاً للوهلة الأولى هذا غير ممكن بشكل مباشر ، لكن يمكنك استخدام Google Apps Script كما أخبرتك لإنشاء وظائف مماثلة في Google Sheets وطبعاً مستقبلاً سأحاول ادراج موضوع بهذا الخصوص ( لضيق الوقت 😇 )

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

ما هو انا مش فاهم اعتقد المفروض فى جدول مساعد خدمى المفروض يكون به اسماء الفترات والرقم المعرف لكل فترة وكان السبب فى الاتجاه الى التعامل مع المعرف هو رد الاستاذ ابو خليل الموضوع محتاج لفهم جيد فهم السؤال شطر الجواب

اعتقد أني عرفت المشكلة جرب المثال الان وأخبرنا إذا ظهرت الرسالة أم لا مع تحياتي baseM11.rar

رغم أنني لن ألحظ الخطأ ولم أواجهه في أي من أجهزتي ( كما رأيت سابقاً ) ، إلا أنني سأحاول بعد تجربتي بهذا التعديل :- Private Sub Form_Current() On Error GoTo ErrorHandler If Not IsNull(Me.ID) And Not IsNull(Me.mouadel_3am) Then Dim strSQL As String Dim rs As DAO.Recordset strSQL = "SELECT COUNT(*) FROM (" & _ "SELECT m.mouadel_3am " & _ "FROM info_stagiere i " & _ "INNER JOIN modul m ON i.ID = m.id " & _ "WHERE i.annee='" & Replace([Forms]![frm_examen_fin_formation]![annet], "'", "''") & "' " & _ "AND i.grade='" & Replace([Forms]![frm_examen_fin_formation]![grade1], "'", "''") & "' " & _ "AND i.wilaya='" & Replace([Forms]![frm_examen_fin_formation]![wilaya1], "'", "''") & "'" & _ ") AS T WHERE mouadel_3am >= " & Replace(Me.mouadel_3am, ",", ".") Set rs = CurrentDb.OpenRecordset(strSQL) If Not rs.EOF Then Me.نص73 = rs.Fields(0).Value Else Me.نص73 = Null End If rs.Close Set rs = Nothing Else Me.نص73 = Null End If Exit Sub ErrorHandler: MsgBox "حدث خطأ في حساب الترتيب", vbExclamation + vbMsgBoxRight, "خطأ" Me.نص73 = Null If Not rs Is Nothing Then rs.Close Set rs = Nothing End If End Sub الهدف هو إلمام الحدث بالتأكد من أن mouadel_3am ليس NULL . وحاولت استخدام Replace لتحويل الفاصلة إلى نقطة في الأعداد والقيم الرقمية الكسرية . وإذا استمرت المشكلة لديك ، تحقق من إعدادات الإقليمية (Regional Settings) في الويندوز التي قد تؤثر على تنسيق الأرقام 🤔

تفضل testhol2.rar

السلام عليكم تم عمل بعض التغييرات في الملف حتى تمشي الأمور تمام التمام تم فك الدمج في خلايا الاحتياط لأن معادلة الصفيف لا تقبل الخلايا المدموجة فقط قم تبغيير الرقم في P1 ولاحظ النتيجة ملاحظة : كل المعادلات من نوع الصفيف التي تبدأ بقوس وتنتهي بقوس تفضل جرب الملف _اكمال ملاحظة5.xlsx

السلام عليكم ورحمة الله وبركاته كيف حالكم إخواني الكرام في المنتدى الأغر ... هل ....؟ سؤال موجه لكم وليس لي هل .....؟ والإجابة على السؤال بهل إما بـ "نعم" أو بـ "لا" هل قمت يوماً ما بتحميل مصحف كامل لأحد القراء المحببين إليك؟ إذا كانت الإجابة بنعم انتقل للسؤال الثاني وإذا كانت الإجابة بـ "لا" .. مش عيب عليك تحمل أفلام ومسلسلات وألعاب وناسي كتاب الله السؤال الثاني : هل بعد عملية التحميل وجدت أن المجلد الذي يحتوي على السور مرقمة من 001 و 002 إلى 114 بدون أسماء السور؟ إذا كانت الإجابة بـ "نعم" فإليك الحل السحري مع الإكسل .. الحل هو دمج أسماء السور مع الاحتفاظ بالرقم أيضاً من أجل ترتيب السور ، لتصبح في النهاية بهذا الشكل 001 - الفاتحة ، 002 - البقرة وهكذا!! خطوات العمل : ************** قم بنسخ المصنف الذي سأقوم بإرفاقه في نفس مسار المجلد الذي يحتوي على السور القرآنية .. افتح المصنف .. اضغط زر الأمر .. وشكراً لكم على حسن تعاونكم معنا أترككم مع الملف :fff: Rename Quran Files.rar

السلام عليكم ورحمه الله وبركاتة اسف على التاخير اخي الكريم لانشغالي في بعض الامور تم التعديل على الملف بحيث يرحل كذالك الى شيت تلفونات العملاء شاهد الملف واخبرني عن اي خطوه اخرى تريد عملها اقبل تحياتي واحترامي الترحيل على صفحه العملاء.rar