ياسر خليل أبو البراء

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

أخي الفاضل محمد الداودي يكفيني أن تذكرني بدعوة بظهر الغيب .. بارك الله فيك ووفقك الله لما يحب ويرضى تقبل تحياتي

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

أخي الكريم محمد الزريعي اطلعت على الملف وما زال هناك مسافات زائدة في بعض الخلايا الخاصة بأسماء البنوك في ورقة التمويل .. عموماً إليك الحل التالي وإن شاء الله يفي بالغرض ويؤدي المطلوب جرب الكود وستجد أن بعض النتائج غير صحيحة بسبب أن هناك مسافة زائدة Sub CustomSort() Dim Sh As Worksheet, LR As Long Dim ws As Worksheet Set Sh = Sheets("التمويل") Set ws = Worksheets("h") LR = Sh.Cells(Rows.Count, 1).End(xlUp).Row With Sh.Sort .SortFields.Clear .SortFields.Add Sh.Range("K3"), CustomOrder:=SortItems(ws.Range("R2:R13")) .SortFields.Add Sh.Range("R3"), CustomOrder:=SortItems(ws.Range("O2:O12")) .SortFields.Add Key:=Sh.Range("Q3"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers .SetRange Sh.Range("A2:T" & LR) .Header = xlYes .Apply End With End Sub Function SortItems(rngSort As Range) As String Dim ArrSort() As Variant Dim I As Long ReDim ArrSort(1 To rngSort.Rows.Count) For I = 1 To UBound(ArrSort) ArrSort(I) = rngSort(I, 1) Next SortItems = Join(ArrSort, ",") End Function تقبل تحياتي الملف الاصلي بكامل الاكواد.rar

ممكن تضرب بمثال من واقع ملفك المرفق لتتضح الصورة أكثر .. اعذرني لأنني ضعيف في التعامل مع الفورم ولكني أحاول المساعدة قدر الإمكان ..ولعل أن أحد الأخوة يتدخل في الموضوع ليساعدك

في انتظار المرفق الأخير بعد تعديل وضبط البيانات تقبل تحياتي

أخي الحبيب سعيد تهت مني تاني .. بالنسبة الأول لعدد النسخ يتم من خلال التعديل في هذا الجزء Copies:=2 بالنسبة للنسخة الثالثة هل ستكون كما هو الحال بالنسبة للأولى أم بالنسبة للثانية؟ أي هل سيتم إخقاء التفقيط والصفوف ؟ أم إظهار التفقيط والصفوف ..؟؟

الحمد لله إخواني أن أعجبكم الشرح واستفدتم منه بارك الله فيكم وفي انتظار ابداعاتكم بالمنتدى .. على قدر ما تعطي ستتعلم

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

أخي الكريم محمد الزريعي الملف المرفق به أخطاء كثيرة سينتج عنها عدم الدقة في الترتيب .. أولاً : يوجد مسافات زائدة في البيانات ..لذا أنصح أولاً أن ترفق الملف الأصلي بعد استخدام الدالة Trim لإزالة المسافات الزائدة في الملف ببساطة في عمود بعيد عن جدول البيانات اكتب مثلاً في الخلية G5 المعادلة التالية بهذا الشكل =TRIM(B5) ثم اسحب المعادلة لليسار بمقدار 3 أعمدة لتشمل جميع البيانات ثم قم بسحب المعادلات إلى آخر صف به بيانات ثم قوم بنسخ النطاق الذي به المعادلات كليك يمين ثم نسخ وروح للخلية B5 واعمل كليك يمين ثم لصق خاص ثم انسخ القيم .. كرر نفس الكلام مع ورقة العمل المسماة h حيث يراعى أن يكون العمود الثاني والخامس اللذان سيحتويان القائمة المخصصة بدون مسافات زائدة ثانياً :لابد من مراعاة أن تكون الكلمة متشابهة في الكتابة أي أن كلمة الراجحى غير كلمة الراجحي .. لاحظ آخر حرف في الكلمة ى غير ي أفضل إرفاق ملفك الأصلي وليس ملف نموذج عن الملف الأصلي ..حيث أنني لا أدري هل سيعمل الكود مع ملفك الأصلي أم أنه ستقابلك نفس المشكلة التي قابلتك مسبقاً .. فلابد من التجربة قبل إرفاق الكود حتى لا أضيع وقتك .. ارفق ملفك الأصلي وإذا كنت تخشى أن البيانات هامة في الملف الأصلي ابعث به في رسالة خاصة بعد أن تقوم برفعه على موقع رفع خارجي تقبل تحياتي

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

أخي الحبيب سعيد بيرم هو دا الكلام ..كدا أقدر أقدم المساعدة بقدر ما أعلم إليك الكود التالي فيه ما تطلب إن شاء الله جرب ومتنساش تدعي لي Sub Print_All() Dim Sh As Worksheet, LR As Long, Cel As Range Dim Stx1 As String, Stx2 As String, St1 As String, St2 As String Dim Texte1 As String, Texte2 As String Set Sh = Sheets("فاتورة") LR = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row Stx1 = "جنيها ": Stx2 = "قرشا ": St1 = "و ": St2 = "لاغير" Texte1 = NoToTxt2(Cells(LR, "J")) Texte2 = NoToTxt2(Cells(LR, "I")) Range("del_range").NumberFormat = ";;;" For Each Cel In Range("A8:A" & LR) If Left(Cel.Value, 6) = "ماقبله" Then Cel.Offset(-3, 0).Resize(3).EntireRow.Hidden = True Next Cel Range("A" & LR).Offset(3, 0).Resize(3).EntireRow.Hidden = True ActiveSheet.PrintOut Copies:=1 Range("A8:A" & LR + 5).EntireRow.Hidden = False With Cells(LR + 1, "B") .Value = "إجمالى الفاتورة : " .HorizontalAlignment = xlLeft .Offset(1, 0).Value = "ما عدا السهو والخطأ" If Cells(LR, "I") = 0 Then .Offset(, 1).Value = "فقط " & Texte1 & Stx1 & St2 Else .Offset(, 1) = "فقط " & Texte1 & Stx1 & St1 & Texte2 & Stx2 & St2 .HorizontalAlignment = xlRight End With Range("del_range").NumberFormat = "00" ActiveSheet.PrintOut Copies:=2 Range(Cells(LR + 1, "B"), Cells(LR + 2, "C")) = "" End Sub تقبل وافر تقديري واحترامي

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

وعليكم السلام أخي الكريم محمد الدوادي إليك الملف التالي عله يكون المطلوب تقبل تحياتي CV Employees Import Pictures Based On ID YasserKhalil V2.rar

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

أخي الحبيب سليم أخونا محمد لا يريد استخدام هذه الخاصية حيث تم معالجة الأمر من قبل في الرابط في أول الموضوع باستخدام هذه الخاصية Custom List .. حيث أنه واجه أخطاء في حالة أن القائمة المخصصة كبيرة الحجم .. يمكنك الإطلاع على الموضوع في الرابط الأول لمزيد من التفاصيل .. تقبل تحياتي

أخي تامر قد تكون الأداة التي يقصدها عبارة عن AddIn إضافة تضاف للإكسيل لتؤدي بعض الوظائف وهذه الإضافات عبارة عن أكواد ... وأكره ما أكره أن يبخل الإنسان بمعلومة .. تقبل تحياتي

أخي الكريم تامر أهلاً بك في المنتدى ونورت بين إخوانك على حسب علمي لا يوجد أداة أو طريقة تقوم بفعل ما تقول .. لابد من استخدام الأكواد لتحقيق الهدف .. حيث أن الكود سيحدد النطاق المراد اختباره ثم العمل عليه .. تقبل تحياتي

أخي الفاضل أبو عبد الله الرشود إثراءً للموضوع إليك معادلة أخرى تقوم بالمطلوب إن شاء الله =IFERROR(IF(A2="","",COUNTIF($A$2:$A$100,A2)*1/(--(COUNTIF($A$2:$A$100,A2)=COUNTIF($A$2:A2,A2)))),"") إذا لم تعمل المعادلة معك قم باستبدال الفاصلة العادية بفاصلة منقوطة تقبل تحياتي

أخي الكريم صداكم وجزيت خيراً بمثل ما دعوت لابد من تمكين إعدادات الماكرو لتعمل الأكواد .. وكما قلت ربما يحوي الكود على أسطر تشبه عمل الفيروسات ..فيمكن باستخدام الأكواد مسح الملفات والمجلدات في بارتشن بالكامل .. لذا يجب الحذر والحيطة والإطلاع على الكود قبل تجربته ... وإليك شرح لأسطر الكود لعله يكون معين لك على إنجاز مهمتك Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'يوضع الكود في حدث ورقة العمل ويتم التنفيذ عند النقر المزدوج على الخلايا التي سنقوم بتحديدها '------------------------------------------------------------------------------------------- 'سطر في حالة أن عدد الخلايا التي سيتم التعامل معها أكبر من خلية يتم الخروج من الإجراء 'حيث أن المطلوب التعامل مع خلية واحدة فقط في كل مرة لذا وجب الحيطة والحذر وتحديد خلية واحدة If Target.Cells.CountLarge > 1 Then Exit Sub 'هذا السطر هو الذي يحدد نطاق الخلايا التي ستتمكن من التعامل معها وهي في العمود الثالث 'وأيضاً التعامل سيكون في الصفوف الأكبر من الصف الثالث [C] حيث أننا جعلنا عمود الخلية الهدف يساوي 3 أي العمود 'أي أنه سيتم استثناء الصف الأول والثاني والثالث ويتم التعامل مع الصفوف بدايةً من الصف الرابع If Target.Column = 3 And Target.Row > 3 Then 'سطر لإلغاء تحديث الشاشة وكذلك إلغاء تمكين الأحداث وهذا الإلغاء يسرع من عمل الكود Application.ScreenUpdating = False Application.EnableEvents = False 'عدم السماح بالتعديل في الخلايا الهدف أي أن الخلايا في العمود الثالث 'بدايةً من الصف الرابع لن تتمكن في التعديل عليها بالنقر المزدوج كما 'هو الحال في بقية الخلايا .. وهذا لا يعني أنك لا تستطيع التعديل على الخلايا 'من لوحة المفاتيح [F2] يمكن التعديل باستخدام مفتاح 'أما التعديل عن طريق النقر المزدوج فممنوع في الخلايا المحددة Cancel = True 'تعريف المتغيرات الأول لورقة العمل التي سنقوم بترحيل البيانات إليها 'والمتغير الثاني لمعرفة صف الخلية الهدف التي سيتم التعامل معها Dim Sh As Worksheet, lRow As Long 'تعيين قيمة للمتغير ليساوي ورقة العمل المسماة التقرير Set Sh = Sheets("التقرير") 'تعيين قيمة للمتغير ليساوي صف الخلية الهدف lRow = Target.Row 'بدء التعامل مع ورقة التقرير With Sh 'مسح البيانات الموجودة في الخلايا المحددة في السطر .Range("D5,D7,H8,H11,D11").Value = "" 'شرط ألا تكون الخلية الهدف فارغة أما إذا كانت فارغة فلن يتم تنفيذ الكود If Not IsEmpty(Target) Then 'تساوي التاريخ الحالي [D5] الخلية .Range("D5").Value = Date 'تساوي القيمة الموجودة في العمود الثالث في نفس صف الخلية الهدف [D7] الخلية .Range("D7").Value = Cells(lRow, "C").Value 'تساوي القيمة الموجودة في العمود الرابع في نفس صف الخلية الهدف [H8] الخلية .Range("H8").Value = Cells(lRow, "D").Value 'تساوي القيمة الموجودة في العمود الخامس في نفس صف الخلية الهدف [H11] الخلية .Range("H11").Value = Cells(lRow, "E").Value 'تساوي القيمة الموجودة في العمود السادس في نفس صف الخلية الهدف [D11] الخلية .Range("D11").Value = Cells(lRow, "F").Value 'إظهار رسالة تفيد بأنه تم إعداد التقرير للموظف ثم ذكر اسم الموظف الموجود في العمود الثالث MsgBox "تم إعداد تقرير للموظف " & Cells(lRow, "C").Value & " في ورقة التقرير", 64 'انتهاء جملة الشرط End If 'انتهاء التعامل مع ورقة التقرير End With 'استعادة الإعدادت التي تم إلغائها في بداية الكود Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub تقبل تحياتي

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

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

أخي الكريم السيفاني .. المتغير Range من النوع Object أي كائن وهذا النوع يشغل 4 بايت من مساحة الذاكرة وإليك تفصيل لكل نوع من أنواع البيانات والمساحة التي يشغلها بالذاكرة VBA Data Types.rar

أخي الحبيب أبا الحسن والحسين .. بارك الله فيك وجزيت خيراً على إبداعاتك المتواصلة .واصل بلا فواصل أخي الفاضل أبو حماده جرب التعديل في هذا السطر (بإضافة الرقم المطلوب إضافته) MyFileName = Form1.ComboBox1.Value & " 1" تقبل تحياتي

أخي الحبيب حسام حل رائع وجميل .. تسلم الأيادي يا كبير تقبل تحياتي