omar elhosseini

الاخوة الاعزاء من ارد مني توضيحا يجب عليه اولا توضيح الاتي بدون نقصان 1 - رقم نسخة الاوفيس 2 - ماهي الخطوات التي اتبعتها بالتفصيل من خلال شرحي السابق 3 - اتجاه الاعمدة علي نسخة الاوفيس لديك من اليمين الي اليسار ام من اليسار اليمين 4 - وهل قوائمك عربي ام انجليزي اربع نقاط يجب ذكرها حتي استطيع محاولة ايجاد حل فكيف لي ان اعرف ايجاد حل بدون معرفة التفاصيل بعد الشرح الواضح في بداية الموضوع كل هذا قبل تشغيل المثال المرفق في الشرح

الاخ أيمن ابراهيم ( ألن تحتاج الي رأس للشيت ايضا ( ال 9 صفوف في اول الورقة ناجح

الاخ مهند الزيدي ماهي الخطوات التي اتبعتها بالتفصيل من خلال شرحي السابق

الاخ سليم حاصبيا بعد اذنك اختلف معك في الرأي ناهيك عن استخدام SUMPRODUCT مع الدتا مئات الصفوف من الدتا سيكون الملف بطيئا وليس بالمهم هنا المهم هنا هو ان المستخدم العادي لن يري ما بين السطور لا اكثر من ان يقوم بنسخ الكود الي ملفه اذا فعل ذلك لن يعمل الكود فأذ قام بعض الا خوة بتجربة نسخ الكود خاصتك وبيانات وررقة العمل الي ملف جديد لن يعمل الملف الجديد ارجو من بعض الاخوة تجربة ذلك واخبارنا بالنتبجة انظر ماذا يقول اخونا originallaptop الاخ originallaptop انظر المرفقات Sum_Number_Only.rar اما بالنسبة الي كيف تنقل الاكواد الي ملفك اعمل كما في الفيدو التالي بعد ان تفتح ملفك وتفتح الملف الذي به الاكواد فيديو نقل الاكواد

الاخ مهند الزيدي لقد نوهت انها تعمل جيدا علي اوفيس 2003 و 2010 اما 2007 و 2016 لها بعض المشاكل علي العموم ماهي الخطوات التي اتبعتها بالتفصيل حتي استطيع اجابتك وهل اتجاه الاعمدة علي نسخة الاوفيس لديك من اليمين الي اليسار ام من اليسار اليمين وهل قوائمك عربي ام انجليزي ارجو مما يريد الاستفسار ان يذكر الخطوات السابقة ذات اللون الاحمر بالتفصيل

شرح UserForm Spreadsheet

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته تحياتي إلى الجميع تكملة شرح UserForm Spreadsheet قبل عمل ال TextBox لنستخدمه في البحث او الفلترة سنقوم بعمل بعض التحابيش الجماليه لل Spreadsheet وهي اخفاء لبعض الاشرطه والادوات من ال Spreadsheet لتبدو لنا مثل ListBox تماما كما في الصوره التاليه سيتم اخفاء كل الاشرطة والادوات التي تم تميزها باللون الاحمر ويتم ذلك بأستخدام اجراء تنشيط UserForm وهو UserForm_Activate وتكون الاكواد كالاتي ================================================== Private Sub UserForm_Activate() ' '================================================================== With Spread .DisplayToolbar = False ' اخفاء شريط الادوات With .ActiveWindow .DisplayWorkbookTabs = False ' اخفاء تاب اوراق العمل .EnableResize = False ' اخفاء تاب التحكم في حجم ورقة العمل .DisplayHeadings = False ' اخفاء ترقيم الصفوف و الاعمدة .DisplayHorizontalScrollBar = False 'اخفاء شريط التمرير الافقي .DisplayVerticalScrollBar = False 'اخفاء شريط التمرير الرأاسي End With End With '================================================================== ' End Sub ================================================== والان نكمل المثال بعد تم عرض كامل الدتا داخل Spread 1 - سنقوم بعمل زر للخروج طور الفورم 2 - سنعمل عدد 2 TextBox احدهما للبحث او الفلترة والثاني لمجموع مبالغ المكافئة 3 - سنعمل عدد 2 OptionButton الاول للفلترة من بداية الاسم والثاني للفلترة بأي جزء من الاسم وتكون الاكواد كالاتي في حدث TextBox1_Change كالاتي عند ادراج اى حرف في TextBox1 يبدأ تنشيط هذا الحدث ================================================== Private Sub TextBox1_Change() ' On Error GoTo End_Me Spread.Rows("1:" & Rows.Count).ClearContents 'حذف محتويات ال Spread بالكامل ' '/============================================================= Search_Text = TextBox1 & "*" 'في حالة تنشيظ ال OptionButton1 'توجيه محتوي ال TextBox1 الى المتغير Search_Text 'واضافة علامة النجمة له في نهايته ليكون البحث او الفلترة بجزء من بداية الاسم If OptionButton2 Then Search_Text = "*" & TextBox1 & "*" ' اما في حالة تنشيظ ال OptionButton2 'توجيه محتوي ال TextBox1 الى المتغير Search_Text 'واضافة علامة النجمة له في البداية و النهايته ليكون البحث او الفلترة بأي بجزء من الاسم ScreenOn Sh_Data.Range("A1").AutoFilter Field:=2, Criteria1:=Search_Text 'في ورقة العمل الرئيسية عمل تصفية تلقائية على العمود الثاني (الاسم) 'بمحتوي متغير الفلترة المتغير Search_Text '/============================================================= Sh_Data.AutoFilter.Range.Copy 'بعد الفلترة نسخ ناتج الفلترة من ورقة العمل الرئيسية الي الذاكرة With Spread With .Range("A1") .Paste 'لصق ناتج الفلترة الي ال Spread .Select End With End With '/============================================================= Total = Sh_Data.Range("M1").Value TextBox2 = CStr(Format(Total, "0.00")) 'نسج خلية المجموع ( M1 ) من ورقة العمل الرئيسية الي TextBox2 في الفورم '/============================================================= End_Me: ScreenOn On Error GoTo 0 ' End Sub ================================================== ملحوظة بعد عمل الفلترة على الفورم يمكن التبديل بين بداية الاسم و أي جزء الاسم الملف موجود بالمرفقات_6 تم تجربة المثال علي كل من أوفيس 11 / 2003 و أوفيس 14 / 2010 بدون أي مشاكل وبذلك ينتهي شرح UserForm Spreadsheet والي لقاء قريب بإذن الله مع شرح اداة ثانية نادرة الاستخدام مغمورة مطمورة ================================================== المرفقات_6.rar تحياتى لكم جميعا

والان نبدأ استخدام الاداه بعد تجهيز الملف بجدول البيانات في اول ورقة وايضا بعد تجهيز الملف بال UserForm وادراج الاداة Spreadsheet فى UserForm نبدأ بكتابة الاكواد داخل اجراء البداية لل UserForm وهو اللاجراء الاولي الذي يعمل عند بداية تنفيذ استدعاء ال UserForm وهو UserForm_Initialize وتكون الاكواد كالاتي ================================================== Dim Sh_Data As Worksheet Dim Rng As Range Dim Spread As OWC11.Spreadsheet ' Private Sub UserForm_Initialize() ' Set Sh_Data = Sheets("Data") Set Spread = UserForm1.Spreadsheet1 OptionButton1 = True OptionButton2 = False CommandButton1.Caption = "خـــــروج" ScreenOff '====================================================================== End_Row = Sh_Data.Cells(Rows.Count, "A").End(xlUp).Row 'تحديد رقم اخر صف في ورقة الدتا Set Rng = Sh_Data.Range("A1:K" & End_Row) 'تحديد مدي قاعدة البيانات '====================================================================== Rng.Copy 'نسخ مدي قاعدة البيانات ' With Spread ' With .Range("A1") .Paste 'لصق مدي قاعدة الي شيت الفورم بدء من الخليه A1 .Select End With ' Application.CutCopyMode = Fals .Cells.AutoFit 'احتواء تلقائي لشيت الفورم ' With .ActiveWindow .ViewableRange = Rng.Address 'اجبار شيت الفور علي اظهر مدى قاعدة البيانات فقط لعدم استهلاك الذاكره 'انا اعمل علي اوفيس 2003 ليتوافق مع جميع نسخ الاوفيس 'وهو يحتوي علي صفوف عددها هو 35536 صف 'و يحتوي علي اعمدة عددها هو 256 عمود 'اما داخل ال Spread في UserForm 'فهيي تحتوي علي صفوف عددها هو 262144 صف 'أي عدد الصفوف يساوي 4 امثال ورقة العمل العادية 'و تحتوي علي اعمدة عددها هو 18278 عمود 'أي عدد الاعمدة يساوي 72 ضعف ورقة العمل العادية 'تخيل حجم الذاكرة المستهلكة 'فهذا السطر يجبر ال Spread علي عرض مدي قاعدة البيانات فقط 'تخيل حجم الذاكرة التي تم توفيرها End With ' .RightToLeft = True 'جعل شيت الفورم من اليمين الي اليسار ' End With '====================================================================== Change2Arabic ' End Sub ================================================== المثال_1 بالمرفقات_4 تم تجربة المثال علي كل من أوفيس 11 / 2003 و أوفيس 14 / 2010 بدون أي مشاكل ================================================== المرفقات_4.rar يتبع بعد حفظ الملف و إعادة فتحه مرة اخري ستظهر رسالة تحذيريه من ActiveX Control لأيقاف ظهور هذه الرسالة ينفذ ملف الريجيستري التالي الموجود بالمرفقات_5 الي ان نلتقي مع تكملة المثال ================================================== المرفقات_5.rar يتبع

شرح UserForm Spreadsheet تحياتي إلى الجميع شرح UserForm Spreadsheet هذه الأداة تسمح بنسخ كامل ورقة العمل او مدي محدد منها الي الفورم مع التحكم في الجزء المنسوخ بالتسيق للصفوف والأعمدة والتلوين واشياء كثيرة اخري هذه الاداة UserForm Microsoft Spreadsheet Control ActiveX من ادوات Control ActiveX وهي تتوفر لمستخدي اوفيس 11 و 14 أي لمستخدمي اوفيس 2003 و 2010 بدون اى مشاكل ================================================== اما مستخدمي اوفيس 2007 اما تركيب owc11 Office Web Components الخاصه بأوفيس 11 بدلا من Excel Services ورابط تحميلها من Microsoft موجود بالمرفقات_1 او فأذا لم تعمل الاداة يجب تنفيذ التعليمات التاليه وهي طريقتين بالرابط التالي رابط التعليمات بالمرفق_2 ================================================== المرفقات_1.rar المرفقات_2.rar يتبع اظهار الاداة لمستخدمي اوفيس 2003 و 2010 سوف نتبع كل السبل المتاحه لإظهر الادة الطريقة الاولي اتبع الصور من 1 - 4 في محرر الاكواد الطريقة الثانية اتبع الصور من 5 - 6 في محرر الاكواد بعد اضافة المكتبتين نفذ ما في الصور من 1 الي 4 اذا لم تجد هاتين المكتبتين لا عليك قم بتحميل المرفق_3 ستجد بداخله ملف اكسيل بأسم Add_Reference اضغط علي الزر لتنفيذ ماكرو يعمل علي اضافة هاتين المكتبتين بعد اضافة المكتبتين عن طريق الماكرو نفذ ما في الصور من 1 الي 4 ================================================== المرفقات_3.rar يتبع

الاخ alyfahem Sub kh_Filter() ' Dim LR As Long 10 With Sheet2 20 .Range(.Cells(9, 1), .Cells(Rows.Count, Columns.Count)).ClearContents 30 End With 40 With Sheet1 50 LR = .Cells(.Rows.Count, "AF").End(xlUp).Row 60 .Range("AD6:BH" & LR).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheet2.Range("A1:A2"), CopyToRange:=Sheet2.Range("C9"), Unique:=True 70 End With 80 Range("a3").Select 90 LR = Cells(Rows.Count, "AF").End(xlUp).Row 100 ActiveSheet.PageSetup.PrintArea = Range("b2:AB" & LR).Address ' End Sub السطر 20 يمسح منطقة اخراج البيانات قبل الفلتره من بداية السطر 9 حتي نهاية ترقيم الورقة السطر 50 لتحديد رقم اخر صف في قاعدة البيانات السطر 60 كود للتصفية المتقدمة يحدد فيه مدي قاعدة البيانات ومنطقة مدي شروط التصفية وايضا مدي مخراجات ناتج التفية السطر 90 لتحديد رقم اخر صف في مدي المخراجات السطر 100 يقوم بطباعة مدي المخرجات

الاخ ناصر سعيد لقدروفقن الله وعرفت المشكله وهي مسح منطقة الاخراج قبل الفلتره فيكون الكود كالتالي تم اضافة كومبوبكس لأختيار التقدير وتم تعديل التقيرات في الصفحة الرئيسية لتشمل كل التقديرات لتوضيح عمل الكود Sub kh_Filter() ' Dim LR As Long With Sheet2 .Range(.Cells(9, 1), .Cells(Rows.Count, Columns.Count)).ClearContents End With With Sheet1 LR = .Cells(.Rows.Count, "AF").End(xlUp).Row .Range("AD6:BH" & LR).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheet2.Range("A1:A2"), CopyToRange:=Sheet2.Range("C9"), Unique:=True End With Range("a3").Select LR = Cells(Rows.Count, "AF").End(xlUp).Row ActiveSheet.PageSetup.PrintArea = Range("b2:AB" & LR).Address ' End Sub انظر المرفقات كود فلتره 9.rar مع حبي وتقديري

الاخ أبو قاسم هي ليست اللست بوكس هي اداة نادرا ماتستخدم مع الفورم وتسمي Spreadsheet

الاخ ناصر سعيد تخيل اني انخدعت فلم انظر الي عمود التقدير كلامك صحيح لا يعمل الا مره واحده اسف اخي سأحاول اجد حل له تحياتي

الاخ ناصر سعيد نعم تعاملت ملف الاخ ياسر خليل أبو البراء وسأشرح الكود هذا السطر هو كود الفلتره المتقدمة ( التصفية المتقدمة ) .Range("AD6:BH" & LR) لتحديد مدي قاعدة البيانات xlFilterCopy وهي تحدد النسخخ الي مدي محدد وهو الذي يأتي بعدها ( وممكن يكون النسخ في نفس مكان قاعدة البيانات مثل التصفيه التلقائية ويمكنك تجربة التصفية المتقدمة من قائمة بيانات ثم تصفية ثم تتصصفية متقدمة وعند اجادة استخددامها من القوائم يمكنك تسجيل الماكرو لينتج لك الكود المطلب

الاخ khalidmoh انظر المرفقاات ولكن اتبيع التعليات التالية يجب ان يكون الملف (جمع الدرجات) وملفات الدرجات في فلدر واحد وليس معهم اي ملفات اخري يجب تسجيل اسماء الطلاب فى الورقة المسماه (Temp) بداية من الخلية (A2) والخلية (A1) عنوانها (Name) ملفات الدرجات يجب ان تكون كلها بنفس الترتبب الاسماء يمكنك اضافة اى عدد من ملفات الدرجات الي الفدر او تغير مسمياتها بدون تعديل الكود بالمرفقات ايضا ملف فيديو لعمل الملف فأذا لم يعمل البرنامج معك يكون السبب عندك وليس الملف Omar_1.rar Video_2016-06-05_092321.rar

khalidmoh هل هم 2 ماده فقط ام اكثر ارجو بعض التفصيل لأني بدأت العل بالملف

الاخ أبو إلياس السوري انظر المرفقات book1.rar

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

الشكل النهائي

الاخ طاهر محمد اذا كان المطلوب كهذه الصور ربما استطيع انجازه بدون وعد بذلك ارجو اخبرني قبل رمضان كل عام وانتم بخير و ايضا اخبرني على اي اوفيس تعمل فأنا اعمل علي افيس 11 (2003) وايضا اسلوب البحث بأسم الصنف هل تريد بأي جزء من اسم الصنف ام من بداية اسم الصنف الصور بالمرفقات احتيطيا صوره رقم 1 صوره رقم 2 الصور Omar_1.rar

الاخ بوامجاد طريقة اخري بالمرفقات Private Sub Workbook_Open() ' Filter_On_Hide_Me ' End Sub Sub Filter_On_Hide_Me() ' Dim Cel As Range Dim Rng As Range Set Rng = Range("A5:P5") Application.ScreenUpdating = False If Not ActiveSheet.AutoFilterMode Then ActiveSheet.Range("A5").AutoFilter End If For Each Cel In Rng If Cel.Column <> 7 Then Cel.AutoFilter Field:=Cel.Column, VisibleDropDown:=False End If Next Application.ScreenUpdating = True ' End Sub Sub Show_All() ' Application.ScreenUpdating = False If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData End If Application.ScreenUpdating = True ' End Sub طريقة اخري بالمرفقات Employee_1.rar

لعله خيرا بإذن الله

الا خ مصطفى محمود مصطفى اخي انا اعمل علي اوفيس 11 وهو يعمل جيد

الاخ طاهر محمد الخ أبو حنــــين طريقه اخري بالمرفقات 1_مشتريات - جديد.rar

الا خ مصطفى محمود مصطفى استخدم هذا الكود قبل الطباعة Sub CopyHeadersFooters() ' Dim Sh As Worksheet Sheets("البيانات").Select With ActiveSheet.PageSetup lh = .LeftHeader ch = .CenterHeader rh = .RightHeader lf = .LeftFooter cf = .CenterFooter rf = .RightFooter End With For Each Sh In Worksheets With Sh.PageSetup .LeftHeader = lh .CenterHeader = ch .RightHeader = rh .LeftFooter = lf .CenterFooter = cf .RightFooter = rf End With Next ' End Sub