عبدالله بشير عبدالله

وعليكم السلام ورحمة الله وبركاته ارجو ان تتعامل مع الملف المرفق بالمشاركة الحالية حتى نصل الى تحقيق المطلوب مع الاعضاء والخبراء الملف كروت_05.xlsb

السلام عليكم بعد اذن الاساتذه الافاضل 𝒜ℬ𝒪 𝒴𝒪𝒰𝒮ℰℱ بالنسبة البحث بالمدينة اذا تكرر اسم المدينة لاكثر من شخص فالكود سيحضر اول اسم فقط في حال اظهار البيانات في التكستبوكسس جرب الملف ينقصه البحث بالمدينة طباعة العقد / لا توجد صفحة خاصة بهذا الامر ارجو التوضيح اكثر انتبه الى عنوان المشاركة فكلمة عاجل تعتبر من الكلمات الممنوعة كما جاء في قوانين المشاركة كما يلي 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... جرب الملف وحدد النقاط بوضوح التي تحتاج الى تعديل او تصحيح كروت_05.xlsb

بعد اذن استاذنا ابو احمد المعادلة =IFERROR(INDEX($B$2:$B$9;MATCH(G2;$A$2:$A$9;0));"") اسحبها الى h7 الملف ضبط اليوم مع التاريخ.xls

السلام عليكم يدويا او عن طريق كود Sub AlignTextBox() Dim ws As Worksheet Dim txtBox As Shape Dim rng As Range Set ws = ActiveSheet Set txtBox = ws.Shapes("TextBox1") Set rng = ws.Range("B2:D4") With txtBox .Left = rng.Left .Top = rng.Top .Width = rng.Width .Height = rng.Height End With End Sub Set txtBox = ws.Shapes("TextBox1") يمكن تعديل اسم التكست Set rng = ws.Range("B2:D4 تعديلها حسب المكان محاداة testbox.xlsb

السلام عليكم يمكن عن طريق رسم دائرة على الخلية الكود Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Column > 7 And Target.Column < 31 And Target.Row > 5 Then Cancel = True Dim ws As Worksheet Set ws = ActiveSheet Dim shp As Shape For Each shp In ws.Shapes If Not Intersect(shp.TopLeftCell, Target) Is Nothing Then shp.Delete End If Next shp With ws.Shapes.AddShape(msoShapeOval, Target.Left, Target.Top, Target.Width, Target.Height) .Fill.Visible = msoFalse .Line.ForeColor.RGB = RGB(255, 0, 0) End With End If End Sub الملف دائرة حمراء.xls

وعليكم السلام ورحمة الله وبركانه طلبك واضح والامر ليس بالسهولة التي تتصورها فالشروط كثيرة والتساؤلات اكثر ومنها اذا كان حضور الموظف بعد العاشرة ما تصنيفه على كل حال الكود حسب الشروط الثي دكرنها في طلبك والذي اراه انا غير مكتمل لانه اي موظف يحضر بعد الساعة العاشرة بأخد يوميته كاملة الملف لائحة ضبط الدوام.xlsm

وعليكم السلام ورحمة الله وبركاته اخي الفاضل كان من المفترض ان يكون العمود A في كل الشيتات ترقيم حتى يمكن الحذف باختيار الصف من الترقيم على كل حال تم انشاء ترقيم تلقائي في عمود اخر عتد الدخول على الفورم سيكون الكمبوكس1 فارغا قم باختيار الصفحة المراد حذف البيانات منها اتمنى ان يكون الملف قيه طلبك نموذج الكهرباء _ اكسيل.xlsm

وعليكم السلام ورحمة الله وبركاته لم افهم جملة (لما تشوف التداخل) هل تقصد التعارض ام ماذا وما هو رقم المجمع ضع في الملف حالة او اكثر للتداخل موضحا ارقام المجمع واي يساعد في فهم فكرة الملف وارقفه من جديد في انتظار الشرح و التوضيح اكثر لك كل التقدير والاحترام

السلام عليكم تم التعديل ان شاء الله عمل احصائية.xlsm

اتمنى لك كل التوفيق

وعليكم السلام ورحمة الله وبركانه اضطررت الى تعديل الجدول قليلا في صفحة جدوال الشرائح الكود Sub CalculateRanges() Dim wsClients As Worksheet Dim wsRanges As Worksheet Dim lastRowClients As Long Dim i As Long, j As Long, k As Long Dim count As Long Dim total As Double Dim depositValue As Double Dim rangeStart As Double Dim rangeEnd As Double Dim ranges As Variant Dim colIndex As Variant Dim infiniteRows As Variant Set wsClients = ThisWorkbook.Sheets("العملاء") Set wsRanges = ThisWorkbook.Sheets("جدوال الشرائح") lastRowClients = wsClients.Cells(wsClients.Rows.count, 1).End(xlUp).Row ranges = Array(Array(3, 7, 3), Array(10, 14, 4), Array(17, 21, 5), Array(24, 28, 6), Array(31, 35, 7)) infiniteRows = Array(7, 14, 21, 28, 35) For k = LBound(ranges) To UBound(ranges) wsRanges.Range("D" & ranges(k)(0) & ":F" & ranges(k)(1)).ClearContents For i = ranges(k)(0) To ranges(k)(1) rangeStart = wsRanges.Cells(i, "B").Value If IsInArray(i, infiniteRows) Then rangeEnd = Application.WorksheetFunction.Large(wsClients.Range("C2:C" & lastRowClients), 1) * 10 ' اعتبار القيمة ما لا نهاية Else rangeEnd = wsRanges.Cells(i, "C").Value End If count = 0 total = 0 For j = 2 To lastRowClients depositValue = wsClients.Cells(j, ranges(k)(2)).Value If depositValue >= rangeStart And depositValue <= rangeEnd Then count = count + 1 total = total + depositValue End If Next j wsRanges.Cells(i, "D").Value = count wsRanges.Cells(i, "E").Value = total Next i wsRanges.Cells(ranges(k)(1) + 1, "D").Formula = "=SUM(D" & ranges(k)(0) & ":D" & ranges(k)(1) & ")" wsRanges.Cells(ranges(k)(1) + 1, "E").Formula = "=SUM(E" & ranges(k)(0) & ":E" & ranges(k)(1) & ")" Next k End Sub Function IsInArray(valueToFind As Variant, arr As Variant) As Boolean Dim i As Long For i = LBound(arr) To UBound(arr) If arr(i) = valueToFind Then IsInArray = True Exit Function End If Next i IsInArray = False End Function الملف شرائح.xlsb

الله يحفظك =IF(J15 < 0; "المبلغ ناقص"; "المبلغ كامل") اذا كان الرقم بالسالب تظهر كلمة المبلغ ناقص.xlsx

وعليكم السلام ورحمة الله وبركاته =IF(J15 < 0; "المبلغ ناقص"; "") اذا كان الرقم بالسالب تظهر كلمة المبلغ ناقص.xlsx

وعليكم السلام ورحمة الله وبركانه الملف ____أرقام الجلوس والمناداة - 2025 الرابع.xlsm

طريقة اخرى بدالة غير مباشرة Function GetHyperlinkAddress(rng As Range) As String On Error Resume Next GetHyperlinkAddress = rng.Hyperlinks(1).Address End Function ثم في العمود M نكتب =GetHyperlinkAddress(I2) لرابط اليوتيوب وفي العمود J نكتب لرابط الفيس =GetHyperlinkAddress(J2) الملف qrcode1.xlsb

وعليكم السلام ورحمة الله وبركاته عن طريق كود الكود يتعامل مع العمود I يمكن تغييره الى عمود اخر بالكود Sub ExtractHyperlinks() Dim ws As Worksheet Dim lastRow As Long Dim cell As Range Dim hyperlinkAddress As String Set ws = ThisWorkbook.Sheets("Sheet1") lastRow = ws.Cells(ws.Rows.Count, "I").End(xlUp).Row For Each cell In ws.Range("I2:I" & lastRow) If cell.Hyperlinks.Count > 0 Then hyperlinkAddress = cell.Hyperlinks(1).Address ws.Cells(cell.Row, "M").Value = hyperlinkAddress End If Next cell End Sub الملف qrcode.xlsb

المقصود عند دخول الورقة قائمة الاسماء قي العمود D كلما اضفت اسما او اكثر ولو كان مكررا تجده في القائمة في الخلية وهذا ما يقوم به الكود حاليا عند تغيير الاسم في الخلية I6 نجد مجموع الرواتب في M6 ومجموع السلف في M7 للموظف اذا كانت بياناتك بسيطة فمعادلان اما اذا كانت كبيرة فانصحك بالكود على كل حال اليك الحل عن طريق المعادلات ولك الخيار في استخدام ما يفيدك في عملك DC (1).xlsx

السلام عليكم حسب فهمي لطلبك Jجمع رواتب الموظف ووضعها في M6 وجمع سلفه ووضعها في M7 وذلك حسب الاسم في I6 ان كان كذلك جرب الملف القائمة في I6 يتم تحديثها عند الدخول الى الورقة لوحدها DC (1).xlsb

السلام عليكم اخى الفاضل الاسباب كثيرة منها ربما الإصدارين مثبتان بشكل صحيح وتوجد تعارضات بينهما ربما عدم وجود Microsoft Forms 2.0 Object Library ربما التحديثات التلقائية لأحد الإصدارين إلى تعطيل أو إفساد إعدادات الإصدار الآخر على كل حال ارفاق ملف يقفل باب ربما في انتظار ارفاق ملفك لاصدار 2016 وهو الموجود حاليا على جهازي لك كل الود والاحنرام

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

وعليكم السلام ورحمة الله وبركانه الكود Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Not Intersect(Target, Me.Range("B:B")) Is Nothing Then Dim c As Range For Each c In Target If c.Value <> "" And IsEmpty(c.Offset(0, 1).Value) Then c.Offset(0, 1).Value = Date End If Next c End If If Not Intersect(Target, Me.Range("D:D")) Is Nothing Then Dim dCell As Range For Each dCell In Target If dCell.Offset(0, 2).Value = "إجازة" Then If Application.WorksheetFunction.CountIfs(Me.Range("D:D"), dCell.Value, Me.Range("F:F"), "إجازة", _ Me.Range("E:E"), ">=" & DateSerial(Year(dCell.Offset(0, -1).Value), Month(dCell.Offset(0, -1).Value), 1), _ Me.Range("E:E"), "<=" & WorksheetFunction.EoMonth(dCell.Offset(0, -1).Value, 0)) > 5 Then dCell.Interior.Color = RGB(255, 0, 0) Else dCell.Interior.ColorIndex = -4142 End If Else dCell.Interior.ColorIndex = -4142 End If Next dCell End If Application.EnableEvents = True End Sub الملف اجاز.xlsb

وعليكم السلام ورحمة الله وبركانه العمود c كود Sub CalculateValues() Dim ws As Worksheet Dim lastRow As Long Dim i As Long Dim colA As Double Dim colB As Double Set ws = ThisWorkbook.Sheets("Sheet1") lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row For i = 1 To lastRow colA = ws.Cells(i, "A").Value colB = ws.Cells(i, "B").Value If colB <= 500 And colA > 3000 Then ws.Cells(i, "C").Value = colA * 1.5 ElseIf colB > 500 And colA > 3000 Then ws.Cells(i, "C").Value = colA * 2.5 ElseIf colB < 500 And colA < 3000 Then ws.Cells(i, "C").Value = 6000 Else ws.Cells(i, "C").Value = "" End If Next i End Sub العمود d معادلة =IF(B1<500; IF(A1>3000; A1*1.5; 6000); IF(A1>3000; A1*2.5; "")) test2025.xlsb

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

وعليكم السلام ورحمة الله وبركاته Private Sub Workbook_Open() On Error Resume Next ThisWorkbook.Sheets("الــــــــــــــــوارد ").ScrollArea = "A1:I753" End Sub "A1:I753" هذا النطاق يمكن تعديله وهو المسموح الكتابه به اذا اردت النطبيق على جداول اخرى انسخ ThisWorkbook.Sheets("الــــــــــــــــوارد ").ScrollArea = "A1:I753" والصقه بالكود وغير اسم الصفحة والنطاق سجل.xlsb

السلام عليكم بعد اذن الاساتذة الاكارم معادلة =IF(L10>0;L10&" فدان";"") & IF(AND(L10>0;K10>0);" و ";"") & IF(K10>0;K10&" قيراط";"") & IF(AND(OR(L10>0;K10>0);J10>0);" و ";"") & IF(J10>0;J10&" سهم";"") & IF(AND(OR(L10>0;K10>0;J10>0);I10>0);" و ";"") & IF(I10>0;I10&" م²";"") الملف مساحة.xlsx