Foksh

أخي الفاضل @abdelazizladour ، صدقني لو أنك اجتهدت على توضيح المطلوب وشرحه شرحاً وافياً كافياً لوجدت الكثير من أيدي المساعدة والحلول . نرجو منك الإلتزام بقوانين المنتدى من خلال الدلالة على المشكلة من خلال العنوان ، والتوضيح في الشرح بشكل يسمح للآخرين فهم ما تحاول قوله وتنفيذه وإيجاد حل له .

وعليكم السلام ورحمة الله وبركاته .. للأسف لا توجد معادلة مباشرة في اكسل ( على حد علمي ) تقوم تلقائياً بتجربة قيم مختلفة حتى يتحقق شرط معين ، ولكن يمكنك تحقيق هذا باستخدام أداتين رئيستين :- استخدام أداة "Goal Seek" ( البحث عن الهدف ) ، وهنا مجموعة فيديوهات قد تفيك بالتعرف على هذه الإداة . استخدام "Solver" ( وهي أكثر فاعلية وأكثر قوة ) . وهذا رابط فيديو لشرح بسيط قد يفيدك . وهذا رابط فيديو لطريقة تفعيل Solver . ومتأكد أنك ستجد من خبراء هذا القسم الكبير ومعلميه الفائدة المباشرة من خلال تجاربهم .

وعليكم السلام ورحمة الله وبركاته ،، هي فعلاً أحد المشاكل التي يقع فيها مصمم البرنامج عندما لا تكون لديه معلومة حول فكرة ارفاق الملفات كمرفقات بدلا من استعمال المسارات للملفات المرفقة . طبعاً في مشاركة لمعلمنا الأستاذ @jjafferr في هذا الموضوع هنا ، أشار إلى أنه :- "في الاوفيس M365 تم رفع الطاقة التخزينية الى 4 جيجا بشرط يكون الوندوز 64 بت" . طبعاً بعد وقوعك في هذه المشكلة ، سيترتب عليك جهداً كبيراً من العمل ، بحيث ستضطر الى تفريغ الملفات المرفقة من قاعدة البيانات الحالية الى مجلدات خارجية أولاً ( من خلال كود ) ، ثم تعديل نوع الحقل من مرفقات الى نصي للإستبدال بمسار الملف لكل سجل ، ( قد تواجه مشكلة لاحقة في الضرورة الى إتاحة مساحة قليلة لإضافة نموذج يتم من خلاله العمل على افراغ كافة المرفقات الى مجلدات من خلال كود مخصص ، يعتمد على تحديد اسم الجدول واسم الحقل ، وطريقة افراغ المرفقات الى مجلد محدد بحيث يكون معرف لرقم العميل او اسم المستخدم .... إلخ ) وهذا طبعاً بنظري سيأخذ وقت طويلاً نسبياً بسبب حجم القاعدة الحالي وعدد الملفات التراكمي . العديد من الأفكار يمكن تنفيذها ولكنك ستحتاج وقتاً ( ليس تحطيم للمعنويات بقدر ما هو حافز أنه يمكنك افراغ القاعدة وإعادة تشغيلها بطريقة علمية وممكنة ) .

مشاركة مع الأساتذة ، دون الحاجة لإستعلام .. JO_Lab.zip

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

أجدتم بما تفضلتم أخي الفاضل @محمد هشام. ، ومعلوماتك فادتني بشكل واسع في هذا المجال .. أشكر لكم حسن إصغائكم لي على امل أن لا نكون قد خرجنا عن محور الموضوع ( لعدم تشتت القارئ لاحقاً ) .

بارك الله بكم جميعاً أخي الأستاذ @محمد هشام. ، وأثابكم الله على ما قدمتم .. واسمح لي بسؤال متفرع فيما يخص الكود الذي طرحته .. هل لك أن تشرح لي حاجتنا لـ (COUNTIF و SUBTOTAL) ؟🤗؟ ( من باب كسب المعلومة ) وهل اعتمدت فعلاً على مصفوفات فرعية ؟؟ (ReDim a() ومن باب المشاركة وبما أنني قد أخطأت في ماركتي الأولى سابقاً 😅 ، سأقدم فكرتي والتي لا اعتقد انها بكفاءة أفكاركم أهل الديار 🤗 . Sub CopyDataToWorksheets() Dim wsMain As Worksheet, wsNew As Worksheet Dim dict As Object, dataArray As Variant, formatsArray As Variant Dim i As Long, lastRow As Long, targetRow As Long Dim sheetName As String, startTime As Double: startTime = Timer Const ROW_HEIGHT As Double = 20.25 With Application .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False .DisplayAlerts = False .StatusBar = "جاري معالجة البيانات مع الحفاظ على التنسيقات" End With On Error GoTo ErrorHandler Set wsMain = ThisWorkbook.Sheets("معاشات") Set dict = CreateObject("Scripting.Dictionary") lastRow = wsMain.Cells(wsMain.Rows.Count, "A").End(xlUp).Row If lastRow < 5 Then GoTo CleanUp dataArray = wsMain.Range("A5:M" & lastRow).Value formatsArray = wsMain.Range("A1:M" & lastRow).FormatConditions For i = 1 To UBound(dataArray, 1) sheetName = CleanSheetName(Trim(dataArray(i, 5))) If sheetName <> "" Then dict(sheetName) = Empty Next i Application.DisplayAlerts = False For Each wsNew In ThisWorkbook.Worksheets If Not wsNew Is wsMain Then If dict.exists(wsNew.Name) Then wsNew.Delete End If Next wsNew Application.DisplayAlerts = True For Each sheetName In dict.keys Set wsNew = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) wsNew.Name = sheetName wsNew.DisplayRightToLeft = True wsMain.Range("A1:M4").Copy wsNew.Range("A1").PasteSpecial Paste:=xlPasteAll Application.CutCopyMode = False targetRow = 5 For i = 1 To UBound(dataArray, 1) If CleanSheetName(Trim(dataArray(i, 5))) = sheetName Then wsNew.Range("A" & targetRow & ":M" & targetRow).Value = Application.Index(dataArray, i, Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13)) targetRow = targetRow + 1 End If Next i If Not IsEmpty(formatsArray) Then On Error Resume Next wsMain.Range("A5:M" & lastRow).FormatConditions.Copy wsNew.Range("A5:M" & targetRow - 1) On Error GoTo 0 End If With wsNew .Rows.RowHeight = ROW_HEIGHT For i = 1 To 13 .Columns(i).ColumnWidth = wsMain.Columns(i).ColumnWidth Next i .Range("E3").Font.Name = "Arial" End With Next sheetName wsMain.Range("E3").Font.Name = "Arial" wsMain.Activate CleanUp: With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic .EnableEvents = True .DisplayAlerts = True .StatusBar = False End With Debug.Print "تم الانتهاء في " & Format(Timer - startTime, "0.00") & " ثانية" Exit Sub ErrorHandler: MsgBox "حدث خطأ في السطر " & Erl & ": " & Err.Description, vbCritical + vbMsgBoxRight,"" Resume CleanUp End Sub Function CleanSheetName(sName As String) As String Dim illegalChars As Variant, char As Variant illegalChars = Array("\", "/", ":", "?", "*", "[", "]") CleanSheetName = sName For Each char In illegalChars CleanSheetName = Replace(CleanSheetName, char, "_") Next char If Len(CleanSheetName) > 31 Then CleanSheetName = Left(CleanSheetName, 31) End If End Function

تم تعديل الاستعلام بشكل صحيح ، في المشاركة السابقة

أخي جو الخطأ منك ، حيث في استعلامك يتم تحديث حقل مختلف في جدول مختلف عن الحقل الموجود في الاستعلام مصدر النموذج الفرعي انظر التعديل الصحيح :- DoCmd.RunSQL "UPDATE Tbl_Lab_All SET External_lab = 'المختبر' " & _ "WHERE PCode = [ID];" وقم بإيقاف السطر Me.External_lab = "المختبر"

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

أخي جو ، اعذرني على مداخلتي ، ولكن الصورة غير واضحة ، وكأنها كانت مجرد رفع عتب أنك قمت بالتوضيح بشكل غير واضح !!! ثانياً ، PCode = 40 في الجدول Tbl_Lab_All ، يمثل السجل "هاجر عشرى على" على سبيل المثال . فكيف تريد تحديث القيمة لباقي السجلات , ولكن تبين لي أن الرابط فيما بينهم هو حقل التاريخ إن لم أكن مخطئاً ، صحيح ؟ وعليه فبعد تتبع تنسيق التاريخ في الجدول Tbl_Lab_Requests في الحقل Date_R ، كان التاريخ بالتنسيق "2025-01-12" بينما في النموذج في مربع النص DDate = 12,January,2025 ، أي أن التنسيق مختلف في حال قمنا بتحديد التاريخ كشرط للسجلات التي تتبع نفس التاريخ للتحديث . انظر ماذا تستطيع فعله لتلافي هذه المشكلة في تصميمك لمشروعك .

السبب أن الاستعلام يستخدم القيمة من النموذج الرئيسي ([Forms]![Laboratory]![id]) ، بينما السجلات التي تريد تحديثها موجودة في النموذج الفرعي المستمر ، أي أن هناك عدة سجلات بنفس PCode ، لكن التحديث يستهدف سجلًا واحداً فقط . ويجب أن تأخذ قيمة المفتاح (PCode) من السجل الحالي في النموذج الفرعي ، وليس من النموذج الرئيسي . لذا جرب هذا التعديل ، رغم انك تعلم جيداً ضرورة ارفاق ملف في معظم الطلبات والاستفسارات.. DoCmd.RunSQL "UPDATE Tbl_Lab_Requests SET R_External_lab = 'المختبر' " & _ "WHERE PCode = " & Forms!Frm_Main!Frm_Sub.Form!PCode & ";" فقط تأكد من اسم نموذج الفرعي والرئيسي اخي الكريم ..

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

اخي الكريم @jo_2010 ، ارفق الكود مكتوب وليس صورة اذا تكرمت .

ولا يهمك اخي الكريم ، خذ راحتك ، واليوم فعلاً انا خارج المنزل وبعيد عن الكمبيوتر الى صباح غد إن شاء الله 🤗😇

وعليكم السلام ورحمة الله وبركاته ،، باعتقادي ما ينطبق على اكسيس يمكن ان ينطبق على اكسل . فأولاً يلزمك تثبيت مكتبة SDK منموقع الشركة ZKTeco من هذه الصفحة هنا ( يلزمك تسجيل الدخول طبعاً للتحميل من الموقع الرسمي ) . حيث انها تحتوي على مكتبة الوظائف التي تسمح بالاتصال المباشر بالجهاز . بعد تحميل البرنامج من الموقع الرسمي ، قم بتسجيل المكتبة zkemkeeper.dll كما يلي :- افتح موجه الأوامر CMD كمسؤول ، ثم استخدم السطر التالي مع تعديل مسار الملف السابق حسب مسار التثبيت لديك :- regsvr32 "C:\المسار\zkemkeeper.dll" ثم قم بإضافة المكتبة بحيث أن تفعّل خيار: zkemkeeper.dll أو ZKEMkeeper 1.0 Type Library الآن كود VBA بسيط للاتصال بالجهاز :- Dim zk As New zkemkeeper.CZKEM Sub ConnectToDevice() Dim connected As Boolean connected = zk.Connect_Net("192.168.1.201", 4370) If connected Then MsgBox "تم الاتصال بالجهاز بنجاح" Else MsgBox "فشل الاتصال بالجهاز" End If End Sub تأكد من عنوان IP الخاص بالجهاز طبعاً . وهذه دالة لجلب سجلات الحضور :- Option Explicit Dim zk As New zkemkeeper.CZKEM Sub GetAttendanceLogs() Dim ip As String: ip = "192.168.1.201" ' لجهاز البصمة لديك IP غيّر هذا العنوان إلى عنوان Dim port As Long: port = 4370 ' المنفذ الافتراضي عادةً Dim iMachineNumber As Long: iMachineNumber = 1 Dim connected As Boolean connected = zk.Connect_Net(ip, port) If Not connected Then MsgBox "فشل الاتصال بالجهاز. تحقق من الشبكة أو الإعدادات", vbCritical Exit Sub End If zk.EnableDevice iMachineNumber, False If Not zk.ReadGeneralLogData(iMachineNumber) Then MsgBox "لا توجد سجلات متاحة ، أو تعذر قراءتها", vbExclamation zk.EnableDevice iMachineNumber, True zk.Disconnect Exit Sub End If Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("Sheet1") ws.Cells.ClearContents ws.Range("A1:E1").Value = Array("UserID", "DateTime", "State", "Verified", "WorkCode") Dim userID As Long, verifyMode As Long, inOutMode As Long Dim year As Long, month As Long, day As Long Dim hour As Long, minute As Long, second As Long Dim workCode As Long Dim row As Long: row = 2 Do While zk.SSR_GetGeneralLogData(iMachineNumber, CStr(userID), _ verifyMode, inOutMode, year, month, day, hour, minute, second, workCode) Dim dt As String dt = Format(DateSerial(year, month, day) + TimeSerial(hour, minute, second), "yyyy-mm-dd hh:nn:ss") ws.Cells(row, 1).Value = userID ws.Cells(row, 2).Value = dt ws.Cells(row, 3).Value = inOutMode ws.Cells(row, 4).Value = verifyMode ws.Cells(row, 5).Value = workCode row = row + 1 Loop zk.EnableDevice iMachineNumber, True zk.Disconnect MsgBox " تم سحب عدد " & row - 2 & " من سجلات الحضور بنجاح", vbInformation End Sub شرح الأعمدة :- UserID = رقم الموظف DateTime = تاريخ ووقت الحضور/الانصراف State = نوع الحركة (0 = دخول ، 1 = خروج) Verified = طريقة التحقق (بصمة ، كارت ، كلمة مرور) WorkCode = رمز العمل (اختياري ، حيث يعتمد على الجهاز) هذا من وجهة نظري بعد التعديل فيما يتوافق مع اكسل ( مشتق من أكواد آكسيس ) ولكم التجربة طبعاً لأنني حالياً لا أملك جهاز البصمة المذكور نوعه سابقاً ..

وعليكم السلام ورحمة الله وبركاته ،، جرب أخي هذا التعديل !! Sub ترحيل_المعاش_ق() Dim wsSource As Worksheet, wsTarget As Worksheet, wsNew As Worksheet Dim sourceData As Variant, outputData() As Variant Dim i As Long, j As Long, lastRowSource As Long, lastRowTarget As Long Dim rowsToDelete As Range, delCount As Long Dim totalCols As Long: totalCols = 13 Dim t As Double: t = Timer Dim professions As Object, profession As Variant Dim colWidths() As Double Dim lastRowAfterInsert As Long ' تخزين أبعاد الأعمدة من ورقة معاشات Set wsTarget = ThisWorkbook.Sheets("معاشات") ReDim colWidths(1 To totalCols) For i = 1 To totalCols colWidths(i) = wsTarget.Columns(i).ColumnWidth Next i Set wsSource = ThisWorkbook.Sheets("DATA") With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual .StatusBar = "جاري معالجة البيانات..." End With ' تثبيت الخط في الخلية E3 With wsTarget.Range("E3") .Font.Name = "Arial" .Font.Bold = True End With lastRowSource = wsSource.Cells(wsSource.Rows.Count, "M").End(xlUp).Row If lastRowSource < 5 Then GoTo CleanUp sourceData = wsSource.Range("A5:M" & lastRowSource).Value ' إنشاء قاموس للمهن Set professions = CreateObject("Scripting.Dictionary") For i = 1 To UBound(sourceData, 1) If LCase(Trim(sourceData(i, 13))) = "معاش" Then profession = Trim(sourceData(i, 5)) If Not professions.Exists(profession) Then professions.Add profession, Nothing End If End If Next i ' معالجة كل مهنة For Each profession In professions.Keys ' إنشاء أو تحديد الورقة الخاصة بالمهنة On Error Resume Next Set wsNew = ThisWorkbook.Sheets(profession) On Error GoTo 0 If wsNew Is Nothing Then Set wsNew = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) wsNew.Name = profession Else ' حذف البيانات القديمة مع الحفاظ على التنسيق wsNew.Cells.ClearContents End If ' نسخ الترويسة من ورقة معاشات wsTarget.Range("B3:J3").Copy wsNew.Range("B3").PasteSpecial Paste:=xlPasteAll Application.CutCopyMode = False ' نسخ البيانات الخاصة بالمهنة الحالية delCount = 0 ReDim outputData(1 To UBound(sourceData, 1), 1 To totalCols) For i = 1 To UBound(sourceData, 1) If LCase(Trim(sourceData(i, 13))) = "معاش" And Trim(sourceData(i, 5)) = profession Then delCount = delCount + 1 For j = 1 To totalCols If (j = 9 Or j = 12) And IsDate(sourceData(i, j)) Then outputData(delCount, j) = Format(sourceData(i, j), "yyyy/mm/dd") Else outputData(delCount, j) = sourceData(i, j) End If Next j End If Next i If delCount > 0 Then lastRowTarget = wsNew.Cells(wsNew.Rows.Count, "B").End(xlUp).Row If lastRowTarget < 5 Then lastRowTarget = 4 Set targetRange = wsNew.Range("A" & lastRowTarget + 1).Resize(delCount, totalCols) targetRange.Value = Application.Index(outputData, Evaluate("ROW(1:" & delCount & ")"), Evaluate("COLUMN(A:M)")) ' تطبيق التنسيق With targetRange .Borders.LineStyle = xlContinuous .Borders.Weight = xlMedium .Borders.ColorIndex = xlAutomatic .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .ShrinkToFit = True With .Font .Name = "Arial" .FontStyle = "غامق" .Size = 12 End With End With With wsNew.Range("B5:B10000") .HorizontalAlignment = xlRight .VerticalAlignment = xlCenter End With ' ضبط ارتفاع الصفوف wsNew.Rows("5:" & (lastRowTarget + delCount)).RowHeight = 20.25 ' ضبط عرض الأعمدة For i = 1 To totalCols wsNew.Columns(i).ColumnWidth = colWidths(i) Next i ' تطبيق التنسيق الشرطي With wsNew.Range("A5:M" & (lastRowTarget + delCount)) .FormatConditions.Delete .FormatConditions.Add Type:=xlExpression, Formula1:="=$M5=""معاش""" With .FormatConditions(1) .Font.Bold = True .Font.Color = -16776961 .Interior.Color = 16764159 .StopIfTrue = False End With End With End If Set wsNew = Nothing Next profession ' حذف الصفوف من ورقة DATA Set rowsToDelete = Nothing For i = 1 To UBound(sourceData, 1) If LCase(Trim(sourceData(i, 13))) = "معاش" Then If rowsToDelete Is Nothing Then Set rowsToDelete = wsSource.Rows(i + 4) Else Set rowsToDelete = Union(rowsToDelete, wsSource.Rows(i + 4)) End If End If Next i If Not rowsToDelete Is Nothing Then rowsToDelete.Delete Shift:=xlUp End If ' تحديث ورقة معاشات With wsTarget lastRowAfterInsert = .Cells(.Rows.Count, "B").End(xlUp).Row If lastRowAfterInsert >= 5 Then With .Range("A4:M" & lastRowAfterInsert) .Sort Key1:=.Columns(12), Order1:=xlAscending, _ Header:=xlYes, Orientation:=xlTopToBottom End With With .Range("A5:M" & lastRowAfterInsert) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .ShrinkToFit = True With .Font .Name = "Arial" .FontStyle = "غامق" .Size = 12 End With End With With .Range("B5:B10000") .HorizontalAlignment = xlRight .VerticalAlignment = xlCenter End With .Rows("5:" & lastRowAfterInsert).RowHeight = 20.25 With .Range("A5:M" & lastRowAfterInsert) .FormatConditions.Delete .FormatConditions.Add Type:=xlExpression, Formula1:="=$M5=""معاش""" With .FormatConditions(1) .Font.Bold = True .Font.Color = -16776961 .Interior.Color = 16764159 .StopIfTrue = False End With End With End If End With ' تحديث الصيغ With wsTarget .Columns("D").NumberFormat = "0" .Range("A5").FormulaR1C1 = "=IF(RC[1]<>"""",SUBTOTAL(3,R5C2:RC[1]),"""")" .Range("A6:A10000").FormulaR1C1 = .Range("A5").FormulaR1C1 End With عد_الذكور_والإناث_والمعاشات CleanUp: With Application .Calculation = xlCalculationAutomatic .EnableEvents = True .ScreenUpdating = True .StatusBar = False End With Debug.Print "تم الانتهاء في: " & Round(Timer - t, 2) & " ثانية" End Sub

العفو اخي الكريم ..

وعليكم السلام ورحمة الله وبركاته ،، أخي الكريم قبل البدء بطرح الحلول ، هل يوجد اي شروط للسجل الذي تريد حذف أول 3 أرقام منه كما ذكرت ، أم سيكون على جميع السجلات في الحقل EmpID داخل الجدول T1 ؟؟ اذا كان بدون شروط ، فهنا أنت تحتاج لاستعلام تحديث بسيط كالتالي :- UPDATE T1 SET EmpID = Left(EmpID, Len(EmpID) - 3) WHERE Len(EmpID) > 3; في مثالك بعد التعديل ، شوف السجلات قبل تشغيل الاستعلام Query1 وبعد تشغيله إن كانت النتيجة سليمة .. DDFinding Differences-Last.mdb

نرجو من مشرفينا الكرام إغلاق هذا الموضوع ، فقد تم الحل في موضوع آخر ، وتم الإعلان والتوجيه له في المشاركة السابقة.

العفو اخي الكريم 😇 أين كانت مشكلتك ؟؟

تفرق ايه ؟؟؟ الإستدعاء واحد من هنا أو من هناك .. على العموم انا خارج المنزل وبعيد عن الكمبيوتر ، بأقرب فرصة نتابع 😇

اخي الكريم ما تم فقط هو اضافة الدالة السابقة ، وإنشاء مربع نص في التقرير فقط لا غير . ولم يتم تعديل أو فتح أي جزء آخر للأسف 🙄 .

لا اعلم طبيعة العمل في مشروعك الذي تقوم بالتطبيق عليه ، ولكن كما رأيت في ملفك المرفق تم التطبيق بنفس الخطوات التي ذكرتها لك سابقاً.. او ارسل نسختك ليتم التنفيذ عليها.