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

وعليكم السلام ورحمة الله وبركاته يمكنك استخدام المعادلة نم اسخبها للاسفل =TEXT(D7;"dd/mm/yyyy") تحويل التاريخ الى نص.xlsx

وعليكم السلام ورحمة الله وبركاته اخي عبدالله بشير تعديل بسيط للكود Private Sub Worksheet_Calculate() Application.EnableEvents = False Application.ScreenUpdating = False Dim cell As Range Dim rngHide As Range For Each cell In Me.Range("E6:E12") If cell.Value = 0 Then If rngHide Is Nothing Then Set rngHide = cell Else Set rngHide = Union(rngHide, cell) End If End If Next cell Me.Range("E6:E12").EntireRow.Hidden = False If Not rngHide Is Nothing Then rngHide.EntireRow.Hidden = True End If Application.ScreenUpdating = True Application.EnableEvents = True End Sub

وعليكم السلام ورحمة الله وبركاته استخدم هذا المعادله واسحبها الي قدر ما تحتاج من الصفوف =CLEAN(TRIM(C2))

وعليكم السلام ورخمة الله وبركاته جرب هذا الكود Sub MergeSheets_Total() Dim ws As Worksheet, wsTotal As Worksheet Dim i As Long, destRow As Long Dim dateValue As Variant Dim r As Long, lastDataRow As Long Dim sheetName As String On Error Resume Next Set wsTotal = ThisWorkbook.Sheets("TOTAL") On Error GoTo 0 If wsTotal Is Nothing Then MsgBox "لم يتم العثور على الشيت TOTAL", vbCritical Exit Sub End If Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False wsTotal.Range("A3:F320").ClearContents destRow = 3 For i = 1 To 31 sheetName = Format(i, "00") On Error Resume Next Set ws = ThisWorkbook.Sheets(sheetName) On Error GoTo 0 If Not ws Is Nothing Then lastDataRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row If lastDataRow >= 4 Then dateValue = ws.Range("B1").Value For r = 4 To lastDataRow If Trim(ws.Cells(r, "A").Value) <> "" Then wsTotal.Cells(destRow, "B").Resize(1, 5).Value = ws.Cells(r, "A").Resize(1, 5).Value wsTotal.Cells(destRow, "A").Value = dateValue destRow = destRow + 1 End If Next r End If End If Set ws = Nothing Next i Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub The Safe1.xlsb

[الجديد في التحديث 10.60]: 1- في خدمة (فهرسة الآيات القرآنية من خلال الإشارات المرجعية ومن خلال الحقول)، تم إضافة زر (اعتماد وإيقاف عملية الفهرسة) في نافذة (يوجد أكثر من تخريج للآية)، والذي يُمكِّنك من إيقاف عملية الفهرسة نهائياً. 2- في خدمة (إنشاء جدول المحتويات)، تم إضافة خاصية (بدءاً من المستوى)، والتي تسمح لك باختيار مستوى العنوان الذي تود أن تبدأ البادئة من عنده.

ما شاء الله تبارك الله الله يزيدك من فضله - هذا هو طلبي بالضبط اذا فيه امكانية انه ما يظهر البلاغات التي خلصت خير وبركه والا فهذا يكفيني وعند تصدير الاستعلام انه احذفهم يدوي. تقبل خالص شكري وتقديري استاذي العزيز Foksh

اول ورقه مطبوعه ستكون بهذا الشكل وثانى ورقه مطبوعه ستكون بهذا الشكل صح كده ولا انا فهمت حاجه تانيه

استاذي Foksh دائما سباق الى حل مشاكلنا ويعجز حرفنا ان يوفي فيك من شكر لكن لا نملك لك الا الدعاء بظهر الغيب دمت وادامك الله بالستر والعافية تقديري

وعليكم السلام ورحمة الله وبركاته .. جرب هذا الاستعلام إن كان ما فهمته صحيحاً .. SELECT [1].[n], [1].[عميل], [1].[شراء], [1].[ثمن], (Len([شراء])-Len(Replace([شراء],"-",""))) AS [عدد العلامات] FROM 1; بهذا الشكل ستكون النتيجة :- n عميل شراء ثمن عدد العلامات 1 احمد - سجاد - مفرش - نجف 550 3 2 سيد - طقم معلق - طقم شتي - صنية - طقم حلل 1000 4 3 منال - طقم مدهب - بطانية 450 2

تفضل Sub Clean_Trim() Dim rng As Range Set rng = sheet1.Range("C2:C46023") rng.Value = Evaluate("INDEX(CLEAN(TRIM(" & rng.Address & ")),)") End Sub

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

تفضل طريقة احترافية وبأقل عدد من الكائنات Database4.rar

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

تفضل .... غير الشيفرة التي لديك بهذه .... On Error GoTo XYZ If MsgBox("سوف تقوم بحذف الكلية التي ليس لها قسم", vbCritical + vbYesNo, "تحذير") = vbYes Then DoCmd.SetWarnings False DoCmd.OpenQuery "query1" Me.List6.Requery MsgBox "تمت عملية حذف السجلات المطلوب حذفها بنجاح" Else Exit Sub ' خروج فوري إذا المستخدم ضغط "لا" End If Exit Sub ' خروج قبل جزء معالجة الأخطاء '==================== XYZ: MsgBox "حدث خطأ: " & Err.Description

شكرا جزيلا أخي الفاضل وبارك الله فيك وأكثر الله من أمثالك وزادك الله من علمه

وعليكم السلام ورحمة الله وبركاته الكود يرتب حسب العمود H اولا ث ثم يرتب حسب العمود C Sub SortByColumn() Dim ws As Worksheet Dim rng As Range Dim lastRow As Long Set ws = ActiveSheet lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row Set rng = ws.Range("A3:S" & lastRow) With ws.Sort .SortFields.Clear .SortFields.Add Key:=rng.Columns(8), Order:=xlAscending .SortFields.Add Key:=rng.Columns(3), Order:=xlAscending .SetRange rng .Header = xlNo .Apply End With End Sub اتمنى ان تجد فيه طلبك

SELECT IIf(DCount("*","tabe2","id=" & [tabe1].[id] & " AND blagh<" & [tabe2].[blagh])=0,[tabe1].[id],Null) AS [الرقم الوطني], IIf(DCount("*","tabe2","id=" & [tabe1].[id] & " AND blagh<" & [tabe2].[blagh])=0,[tabe1].[ename],"") AS الاسم, IIf(DCount("*","tabe2","id=" & [tabe1].[id] & " AND blagh<" & [tabe2].[blagh])=0,[tabe1].[natio],"") AS الجنسيه, IIf(DCount("*","tabe2","id=" & [tabe1].[id] & " AND blagh<" & [tabe2].[blagh])=0,[tabe1].[gins],"") AS الجنس, IIf(DCount("*","tabe2","id=" & [tabe1].[id] & " AND blagh<" & [tabe2].[blagh])=0,[tabe1].[nid],"") AS [نوع الهويه], IIf(DCount("*","tabe2","id=" & [tabe1].[id] & " AND blagh<" & [tabe2].[blagh])=0, DCount("*","tabe2","id=" & [tabe1].[id] & " AND ([not] Is Null OR [not]='')"), Null) AS [عدد البلاغات], tabe2.blagh AS [رقم البلاغ], tabe2.sanh AS السنه, tabe2.thmh AS التهمه, tabe2.wanted AS [الجهه الطالبه], tabe2.hkm AS الحكم, tabe2.edate1 AS [تاريخ الوارد], tabe2.[not] AS [الاجراء المتخذ], tabe2.edateegra AS [تاريخ الاجراء], tabe2.mlaha AS ملاحظات, tabe2.edathkm AS [تاريخ الحكم] FROM tabe1 INNER JOIN tabe2 ON tabe1.id = tabe2.id ORDER BY tabe1.id, tabe2.blagh; جرب هذا 👌 مع العلم أن اسم الحقل not من الأسماء الممنوعة والمحجوزة في اكسيس ، وليس من الصواب تسمية حقول أو عناصر بأحد هذه الأسماء الممنوعة والتي في هذا الموضوع لأستاذي @ابوخليل https://www.officena.net/ib/topic/39164-الكلمات-والرموز-المحجوزة-في-أكسس-بحث-تطبيق/