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

وعليكم السلام ورحمة الله وبركاته قمت ياستبدال اللستبوكس بالورقة باخر في يوزرفورم فكرة العمل انقر على الخلية المراد وضع الوظيفة بها في العمود B يظهر الفورم قم بالاختيار ويختفى الفورم عند النقر في اي خلية اخرى لك وافر الاحترام والتقدير LISTBOX1.xlsm

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

"بارك الله في وقتك وعلمك، وجعله في ميزان حسناتك." ملاحظة حول البحث عدد المرات وردت كلمة وساوضح بامثلة مثال1 البحث غن كلمة بسم البحث يحصي كلمة بِسَمْعِهِمْ -فَتَبَسَّمَ مثال2 البخث غن كلمة انس البحث يحصي كلمة فَانسلَخَ وهذا حسب وجهة تظري يحتاح الى تعديل طريقة البحث "وهذا العمل أكبر من أن تُحصره أي ملاحظة شكلية." لك تقديري واحترامي

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

وعليكم السلام ورحمة الله وبركاته تم تعديل تعبئة الكموبكس بالعناصر منعا للتكرار وكلما اضفت لونا او مفاسا او صنفا جديد سيتم اظافته للقائمة تلقائيا جرب واعلمني بالنتائج 1فلتر.xlsm

وعليكم السلام ورحمة الله وبركاته الشرط '01'!O$7:O$1020="محول إلى" مكرر مرتين الشرط الاول اتركه كما هو ومحول الى الثانية غيرها الى محولة إلى =IFERROR(INDEX('01'!C$7:C$1020; SMALL(IF(('01'!O$7:O$1020="محول إلى")+('01'!O$7:O$1020="محولة إلى"); ROW('01'!O$7:O$1020)-ROW('01'!O$7)+1); ROWS($A$1:A1))); "") ويمكن تحسين المعادلة الى =IFERROR(INDEX('01'!C$7:C$1020; SMALL(IF(('01'!O$7:O$1020={"محول إلى","محولة إلى"}); ROW('01'!O$7:O$1020)-ROW('01'!O$7)+1); ROWS($A$1:A1))); "") اذا كان اصدار الاكسل 2021 او 365 استخدم المعادلة التالية =FILTER('01'!C$7:C$1020; ('01'!O$7:O$1020="محول إلى") + ('01'!O$7:O$1020="محولة إلى"); "") ان لم تؤدى المعادلة طلبك ارفق ملف به بعض البيانات

وعليكم السلام ورحمة الله وبركاته اليك الملف وبه كود فيه طلبك باذن الله مجموع1.xlsb لك تفديري واحترامي

وعليكم السلام ورحمة الله وبركاته اعتقد تقضد العمود E فهو مخصص لايام الغياب خسب ملفك الكود يحسب جميع الأيام المتتالية السابقة بما في ذلك يوم التاريخ المحدد ولا يخسب الايام التالية بعد التاريخ المحدد اليك الملف test1.xlsb

وعليكم السلام ورخمة الله وبركاته اليك التعديل وارجو ان يكون فيه طلبك غياب 1طلاب.xlsb تحياتي

السلام عليكم ورحمكم الله جرب الكود كلمة السر 123 Sub AdvancedProtectFormulas() Dim ws As Worksheet Set ws = ActiveSheet On Error Resume Next ws.Unprotect "123" On Error GoTo 0 Application.ScreenUpdating = False ws.Cells.Locked = False Dim formulaCell As Range For Each formulaCell In ws.UsedRange.SpecialCells(xlCellTypeFormulas) formulaCell.Locked = True Next formulaCell ws.Protect Password:="123", _ AllowFiltering:=True, _ AllowSorting:=True, _ AllowFormattingCells:=False, _ AllowFormattingColumns:=False, _ AllowFormattingRows:=False, _ AllowInsertingColumns:=False, _ AllowInsertingRows:=False, _ AllowInsertingHyperlinks:=False, _ AllowDeletingColumns:=False, _ AllowDeletingRows:=False, _ AllowUsingPivotTables:=True, _ DrawingObjects:=False, _ Contents:=True, _ Scenarios:=False, _ UserInterfaceOnly:=True Application.ScreenUpdating = True End Sub كما يمكنك السماح ببعض الخصائص والشيت محمى من خلال التعديل في هذا الجزء TRUE او FALSE ' حماية ورقة العمل بكلمة المرور "123" ws.Protect Password:="123", _ ' السماح بتصفية البيانات AllowFiltering:=True, _ ' السماح بفرز البيانات AllowSorting:=True, _ ' عدم السماح بتنسيق الخلايا (مثل تغيير الألوان أو الخط) AllowFormattingCells:=False, _ ' عدم السماح بتنسيق الأعمدة (مثل تغيير العرض أو التنسيق) AllowFormattingColumns:=False, _ ' عدم السماح بتنسيق الصفوف (مثل تغيير الارتفاع أو التنسيق) AllowFormattingRows:=False, _ ' عدم السماح بإدراج أعمدة جديدة AllowInsertingColumns:=False, _ ' عدم السماح بإدراج صفوف جديدة AllowInsertingRows:=False, _ ' عدم السماح بإدراج روابط تشعبية (Hyperlinks) AllowInsertingHyperlinks:=False, _ ' عدم السماح بحذف الأعمدة AllowDeletingColumns:=False, _ ' عدم السماح بحذف الصفوف AllowDeletingRows:=False, _ ' السماح باستخدام الجداول المحورية (Pivot Tables) AllowUsingPivotTables:=True, _ ' عدم حماية الكائنات (مثل الأشكال أو المخططات) DrawingObjects:=False, _ ' حماية محتوى الخلايا (لا يمكن تعديل القيم مباشرة) Contents:=True, _ ' عدم حماية السيناريوهات (Scenarios) Scenarios:=False, _ ' السماح للأكواد البرمجية (VBA) بالتعديل على الشيت حتى مع الحماية UserInterfaceOnly:=True تحياني

وعليكم السلام ورحمة الله وبركاته اليك التعديل حيث الكود يتعامل مع الخلايا المدمجة Private Sub CommandButton2_Click() On Error GoTo ErrorHandler Dim wsSource As Worksheet Set wsSource = ThisWorkbook.Sheets("Sheet4") Application.ScreenUpdating = False Application.Calculation = xlCalculationManual With wsSource .Range("B3:G3").ClearContents .Range("G4:G6").ClearContents .Range("D4:E6").ClearContents .Range("C11:G17").ClearContents .Range("C21:G27").ClearContents .Range("C31:G34").ClearContents .Range("B37:G43").ClearContents .Range("B47:G51").ClearContents .Range("C54:G54").ClearContents .Range("C57:G59").ClearContents .Range("B61:G68").ClearContents End With Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Exit Sub ErrorHandler: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic MsgBox "حدث خطأ: " & Err.Description End Sub

الاساتذة / hegazee - العبيدي رعد السلام عليكم ورحمة الله وبركاته قمت بتجربة الملف المرفق بدون اي تعديل مني بالنسبة لاسماء الصفخات او الكتابة العربية بالاكواد كلها سليمة بالنسبة لكود الترحيل يعمل بكفاءة وبسرعة وفام بطباعة الايصال والترحيل الى شيت DATA كود الترحيل ولغة الملف 100% تعلمنا من معلمنا عبدالله بافشير جزاه الله كل خير وخفظ يمننا السعيد من كل شر ومكروه انه عند نسخ كود ولصقه في مخرر الاكواد انه اذا كان في الكود حروف او كتابة عربية يجب تغيير لغة الكيبورد الى العربية وعندها انسخ والصق وستجد الكود بالحروف العربية اما اذا كانت لغة الكيبورد الانجليزية فالكتابة العربية ستظهر بلغة غير معروفة وهذا عن تجربة لكما ولكل اعضاء المنتدى كل التقدير والاحترام

السلام عليكم ورحمة الله ملف غير مكتمل ولا ادري ارتباط الصفخة بزر الزيادة والنفصان وخيارات الطباعة على كل حال اليك الملف سفيان1 2025-2026.xls

وعليكم السلام ورحمة الله وبركاته الملف المرفق مقال لجداول 3 كلمة السر للاول111 والثاني 222 والثالت 333 يمكن تعديلها من الكود ويمكنك قفل محرر الاكواد بكلمة سر فكرة الكود عند الدخول على الصفخة يتم حماية الجدوال كلها بكلمة سر هي master يمكن تعديلها من الكود للجداول 3 يختار الشخص جدوله يطالب بكلمة سر يكتبها فيتعامل مع جدولة وباقي الجداول محمية يمكنك تعديل نطاف الجداول في الكود اتمنى ان تجد في الملف طلبك تحياتي حماية جدوال متعددة كل جدول بكلمة سر.xlsb

وعليكم السلام ورخمة الله وبركاته اخي لا داعي للاعتذار وملقك ليس مبهما وطلبك يتكرر كثيرا في المنتدى الغموض كان في النتائج المرفقة مع ملفك وخضوصا للسائق اخمد فهي غير صحيحة الملفان السابقان فيهما طلبك ولكن بزر وليس تلقائي فكرة عمل الملف المرفق قم بادخال البيانات لكل السائفين مع العهد والمصروفات ثم استحدم زر الترحيل فيتم انشاء صفخات للسائقين بعدها عند أي تغيير في صفحتي العهدة أو المصروفات، يتم تحديث جميع صفحات السائقين الموجودة تلفائيا ولا تختاج الى زر الترحيل حاليا لديك 3 ملفات كلها تعمل اختر ما يناسب طلبك وكلها تؤدى الى نفس النتيجة اتمنى لك التوفيق جميع السائقين في نفس تلقائي الملف (1).xlsb

السلام عليكم ورحمة الله وبركاته تحياتي لاستاذنا ومعلمنا الفاضل أبوعيد تحياتي للاستاذ الفاضل MAHMOUD ELWY من خلال الاطلاع على الملفات التى ارفقتها لتوضيح الطلب وخصوصا ملف السائق احمد اعتفد ان هناك خطا في فيمة العهدة والمصروفات فهي مكررة وهذا ما اشار اليه استاذنا ابو عيد بعدم لتجاوب السريع من الأعضاء على مشاركتك لوجود الغموض فحسب الصورة العهدة 20000 ولبس 40000 والمصروف 5500 بدل 11000 ويتبقى مع السائق 14500 وليس 29000 هذا خسب قهمى وان كنت مخطئا فارجو توضيخ كيف اتت هذه الارقام وبتاء على فهمى السابق اليك ملفان اخدهما يتشئ ملقات جديدة لكل سائق والاخر في نفس الملف واعتقد لا يوثر ولا يسبب ثقلا للملف كل سائق ملف جديد.xlsbجميع السائقين في نفس الملف.xlsb

وعليكم السلام ورحمة الله وبركانه اليك التصحيج Sub Filter_Class2() Dim WSdest As Worksheet: Set WSdest = Sheets("TI3DAD") Dim D1 As Object, D2 As Object, D3 As Object, D4 As Object Dim I As Long, x As Long, Y As Long, m As Long, z As Long Dim Réf As Variant, ky As Variant, Rng As String Set D1 = CreateObject("Scripting.Dictionary") Set D2 = CreateObject("Scripting.Dictionary") Set D3 = CreateObject("Scripting.Dictionary") Set D4 = CreateObject("Scripting.Dictionary") x = 0: Y = 0: m = 0: z = 0 With WSdest Application.ScreenUpdating = False .Range("M4:V32,X4:AG32,AI4:AR32,AT4:BC32").ClearContents I = 7 Do While I <= .Rows.Count If .Cells(I, 2) <> "" Then Rng = Left(Trim(.Cells(I, 2).Value), 1) Réf = Application.Transpose(.Cells(I, 2).Resize(, 13).Value) Réf = Application.Transpose(Réf) Select Case Rng Case "4" D4(z) = Join(Réf, "*") z = z + 1 Case "3" D3(Y) = Join(Réf, "*") Y = Y + 1 Case "2" D2(x) = Join(Réf, "*") x = x + 1 Case "1" D1(m) = Join(Réf, "*") m = m + 1 End Select I = I + 1 Else Exit Do End If Loop m = 4 If D4.Count > 0 Then For Each ky In D4.Keys .Cells(m, "M").Resize(, 13).Value = Split(D4(ky), "*") m = m + 1 Next ky End If m = 4 If D3.Count > 0 Then For Each ky In D3.Keys .Cells(m, "X").Resize(, 13).Value = Split(D3(ky), "*") m = m + 1 Next ky End If m = 4 If D2.Count > 0 Then For Each ky In D2.Keys .Cells(m, "AI").Resize(, 13).Value = Split(D2(ky), "*") m = m + 1 Next ky End If m = 4 If D1.Count > 0 Then For Each ky In D1.Keys .Cells(m, "AT").Resize(, 13).Value = Split(D1(ky), "*") m = m + 1 Next ky End If .Range("M4").CurrentRegion.Value = .Range("M4").CurrentRegion.Value .Range("X4").CurrentRegion.Value = .Range("X4").CurrentRegion.Value .Range("AI4").CurrentRegion.Value = .Range("AI4").CurrentRegion.Value .Range("AT4").CurrentRegion.Value = .Range("AT4").CurrentRegion.Value Application.ScreenUpdating = True End With End Sub 1تعداد.xlsm

"ههههه والله صدقت، حتى أنا طعج مخي 😂 الله يبارك فيك أستاذي." سؤال طعج مخي حبة الدواء كيف تعرف مكان الوجع!! الملف الذي طعج مخك ومخي اعتقد ان الصفحات الخاصة بالمدن ليس لها علاقة بطلب صاحب السؤال واعتفد انه يريد ترحيل كل مسؤول الى صفحة مستقلة ننتظر صاحب الطلب الفاضل لزيادة التوضيح

السلام عليكم ورحمة الله وبركاته جزاك الله خيرا اخونا Foksh ارحو تعديل الكود بحيث يتم الترحيل خسب المسؤول وليس المدن بالتوفيق استاذنا

السلام عليكم ورحمة الله وبركاته يمكن الاستغناء عن العمود المساعد واستبدال المعادلات في العمود v باخرى ولكنها ستكون طويلة الملف ارقام النتائج عربي2.xlsm

الشئ البسيط يرجعنا الى نقطة الصفر واظهار 99.6 الى 99.60 يمكن وذلك باضافة 0.00 للنتسيق وستصبخ 99.6 الى 99.60 لكن ستظهر الاصفار الارقام الصحيحة 100.00 يعنى تحل اشكال يظهر اخر واعتقد خسب علمى طلبك الاخير لا يتحقق بالتنسيق للخلايا (حسب ما اعلم) بعمود مساعد في Z نضع المعادلات الاصلية به مع النتسيق السابق وفي العمود V نضع المعادلات الجديدة ويمكنك اخفاء العمود Z جرب واتمنى ان تجد طلبك في الملف المرفق او ان يقدم الزملاء بالمنتدى افكار احرى وابسط تحياتي ارقام النتائج عربي1.xlsm

وعليكم السلام ورخمة الله وبركاته هذا التنسيق فيه طلبك مع وجود نقطة للارقام الصحيحة وحقيقة حاولت معالجتها ولم افلح لان النقطة مرتبطة للارقام التي بها كسور ربما احد الزملاء لديه حل اقضل [$-2010401]0.##"٪";-0.##"٪";; ارقام النتائج عربي.xlsm

نعم استاذى الفاضل Foksh صدفت وشكرا لتنبيهك كما اشكر صاخب السؤال الفاضل soik225998 على تنبيهنا للامر تم معالجة الامر ان شاء الله المرشحين2.xlsb

السلام عليكم وهذا ما يقوم به الكود جربت الكود لاكثر من 15اسم الكود يذهب الى الاسم الصحيح في الشيت الصخيح ويحدد الاسم باللون الاصفر اذا كنت تعنى شي اخر ارجو التوضيخ اكثر وارجو من الزملاء التجربة ربما فاتنى شئ لم انتبه له تحياني للجميع

اليك التعديل كلمة المرور 1234 اظافة زر تعديل وخذف للفورم.xlsm