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

وعليكم السلام ورحمة الله وبركاته وهذا ما يقوم به الملف فهل جربت الملف الاول ؟ اكتب اي حرف او اسم في اي صفحة فاذا كات مكررا يتم تلوينه بالاصفر اوتامتيك تلقائيا ربما لديك الماكرو غير مفعل ارفق لك الملف مرة اخرى تلوين الخلايا المكررة (1).xlsb

السلام عليكم كان من الافضل ارفاق الملف ولكن على كل حال اليك ملف يقوم بالحفظ في D DFP1.xlsb

وعليكم السلام ورحمة الله وبركاته اليك ملفان الاول تلقائي بمجرد كنابة اي اسم مكرر في اي صفحة سيم تلوينه بالاصفر مع زر امر لمسح اللون الاصفر الثاني زر امر مع رسالة تحدد التكرار وفي اي صفحة مع زر امر لمسح اللون الاصفر تلوين الخلايا المكررة (1).xlsb تلوين الخلايا المكررة (2).xlsb

وعليكم السلام ورحمة الله وبركاته بالرغم من وضوح طلبك كان الاجدر ارفاق ملف للتطبيق عليه الكود المرفق بسيط ويمكن تعديله Sub TransferData() Dim srcSheet As Worksheet, destSheet As Worksheet Dim mapping As Variant Dim i As Long Set srcSheet = ThisWorkbook.Sheets("تسجيل البيانات") Set destSheet = ThisWorkbook.Sheets("الرئيسية") mapping = Array( _ Array("A", "A"), _ Array("B", "M"), _ Array("C", "N"), _ Array("D", "O"), _ Array("E", "X"), _ Array("F", "Z"), _ Array("G", "AA"), _ Array("H", "AE"), _ Array("I", "AF"), _ Array("J", "AJ"), _ Array("K", "AU"), _ Array("L", "AV")) Application.ScreenUpdating = False Application.Calculation = xlCalculationManual For i = LBound(mapping) To UBound(mapping) With destSheet .Columns(mapping(i)(1)).Clear End With Next i For i = LBound(mapping) To UBound(mapping) With srcSheet .Columns(mapping(i)(0)).Copy Destination:=destSheet.Columns(mapping(i)(1)) End With Next i Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True ' MsgBox "تم نقل البيانات !", vbInformation End Sub ملف استدعاء اعمدة.xlsb

السلام عليكم صباح الخير لم ترفق اي شئ طلبك الاساسي وهو البحث والاظافة والتعديل والحذف قد تحقق فاعتذر عن المواصلة لات الموضوع دخل في طلبات اخرى لم ترفقها في طلبك من البداية مثل اليوزفورم8 والذي ارفقته بعد الانتهاء من طلباتك الاساسية وطلبت منك ارفاق ورقة العقد ولم ترفقها الى الان بالرغم طلبتها متك اكثر من اربع مرات (راجع التعليقات السابقة) وبما انه طلبانك الاساسية قد تحققت افتح موضوع حديد مجهزا فيه ما يتعلق بطلبك شارحا فيه طلبك وستجد ان شاء الله الاستجابة من الاساتذة بالمنتدى حقيقة هذا الموضوع اجهدنى كثيرا وخصوصا اننى تجاوزت 60 سنة اعتذر مرة اخرى ولك كل الاحترام والتقدير

لم ترفق ورقة العقد اين هي ملفات pdf لاقوم بالتجربة كذلك بالاكواد يوجد (MsgBox ("تم اضافة العقد/ (") & Format(UserForm1.TextBox3.Value) & " ) بنجاح ", vbMsgBoxRtlReading + vbCritical + vbOKOnly, "تنبـــــــه") اين هو UserForm1 واين هو TextBox3 غير موجودة لاننى بهذا الوضع لا استطيع عمل شئ بدون ملفات العقود وبدون UserForm1 وTextBox3 لاعرف مهمتها

حقيقة لم افهم الملف الذي ارفقته لاجديد فيه اين ورقة العقد المراد طباعتها ومعاينتها

اين هي ورقة العقد لاعمل لهاكود طباعة ومعاينة حقيقة لم افهم ولا يوجد في ملفك ورقة عقد

كود التعديل والحذق والاظافة والدخول الى الشيت تم تعديلها قي الملف السابق ارجو تحديد اي اكواد تقصد

تم عمل البحث بالمدينة وعدم تكرار رقم البطاقة كروت_07.xlsb

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

تعديلات اخرى على الملف كروت_06.xlsb

السلام عليكم بعض الاقسام غير موجودة يمكنك اظافتها وسحب المعادلة اليها تقرير.xlsx

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