فورم بحث متعدد و خيارات أخرى

[أبو حنــــين]

السلام عليكم

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

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

 

طريقة تصميم فورم بحث عن طريق لست بوكس2.rar

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

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

تقبل الله منا ومنكم صالح الأعمال

[أبو حنــــين]

أخي ياسر

جزاك الله خيرا دائما سباق للخير

تقبل الله منا و منكم صالح الاعمال

[الصـقر]

جزاكم الله خيرا اخى الكريم

اسال الله تعالى ان يزيدكم علما وفضلا وحلما

تقبل تحياتى

[ابو عبدالرحمن البغدادي]

جزيتم خيرا

[محي الدين ابو البشر]

السلام عليكم

جعله في ميزان أعمالك

وجزاك الله كل خير 

اكثر من رائع

دمتم زخراً

[أبو حنــــين]

السلام عليكم :

أخي   الصقر

أخي   أبو عبد الرحمان

أخي  محي الدين

سعدت كثيرا بمروركم العطر ، جزاكم الله خيرا و أنعم عليكم بالصحة ة الهناء و المغفرة

تقبلوا  تحياتي الخالصة

[جلال الجمال_ابو أدهم]

ما شاء الله
تحياتى

[أبو حنــــين]

أخي  جلال الدين

جزاكم الله خيرا على المرور

[أنس دروبي]

السلام عليكم ورحمة الله

بارك الله فيك وجزاك الله كل خير 

اخي وحبيبي علئ هذا الفورم المتميز والسريع في الاداء والقوة في التنفيذ 

اخي الكريم ملفك يصلح لعمل كامل 

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

بارك الله فيك مرة اخرئ ولكن ملفك يصلح معي في اشياء اخرئ 

الذي اريده هو التعديل علئ نفس الكود في المشاركة نظرا لربط الكود في البرمجة باشياء اخرئ وهي تكست بوكسات وليبيل وايضا ليست بوكس 

اشكرك مرة اخرئ علئ تعبك وتمضية الوقت الكثير في انشاء البرنامج 

[أبو حنــــين]

اخي انس جزاك الله خيرا

لقد اجبت عن سؤالك في الموضوع ارجع اليه لتجرب الكود ، و ارجو ان يفي بالغرض

اخي انس جزاك الله خيرا

لقد اجبت عن سؤالك في الموضوع ارجع اليه لتجرب الكود ، و ارجو ان يفي بالغرض

[أبو قاسم]

جميل بارك الله فيك مبدع قليلة في حضرتك

[مهند الزيدي]

عمل رائع أخي العزيز .. " أخوكم في الله " ... وفقك الله لكل خير 

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

[أبو حنــــين]

السلام عليكم

جزاكم الله خيرا اخي ابو قاسم

---------------------------------------------

اخي مهند جزاكم الله خيرا

كنت اتوقع بعض الهفوات في الملف

هناك سطر يجب اضافته

اذهب الى الموديل رقم 2 : Module2

و اكتب تحت هذا السطر  ( السطر السابع ) :.Range("A8:E" & Last).Borders.Value = 0

ضف هذا السطر  : .Range("A8:E" & Last).ClearContents

يصبح بهذا الشكل

 

With sh
Last = .Range("A" & Rows.Count).End(xlUp).Row + 1
.PageSetup.PrintArea = ""
.Range("A8:E" & Last).Borders.Value = 0
'-----------------------------------------------------
.  هذا هو السطر المعني بالاضافة  Range("A8:E" & Last).ClearContents
'-------------------------------------------------------

        .PageSetup.LeftMargin = Application.InchesToPoints(0.5)
        .PageSetup.RightMargin = Application.InchesToPoints(0.5)

 

[مهند الزيدي]

شكراً أخي العزيز  " أخوكم في الله "  على الإستجابة لطلبي بسرعة ..وفقكم الله لكل خير..

تم حل مشكلة عدم تكرار نتائج البحث في الطباعة عن طريق الكود "  Range("A8:E" & Last).ClearContents "..

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

[أبو حنــــين]

مرحبا أخي مهند

ما هي المشكلة في المجموع بالتفصيل لكي اقوم بعلاجها

[مهند الزيدي]

أخي العزيز .. أشكرك على سعة صدرك .. 

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

[أبو حنــــين]

السلام عليكم

كلما تمت التجربة كلما قلت الاخطاء

بالفعل لم اضع الاجمالي في آخر صفحة الطباعة

امسح الموديل 2 و انسخ مكانه الكود التالي

 

Sub iPageSetup()

Application.ScreenUpdating = False
Dim sh As Worksheet, Lr As Integer, Last As Integer
Set sh = Sheets("sPrint")
With sh
Last = .Range("A" & Rows.Count).End(xlUp).Row + 1
.PageSetup.PrintArea = ""
.Range("A8:E" & Last).Borders.Value = 0
'-----------------------------------------------------
.Range("A8:E" & Last).ClearContents
'-------------------------------------------------------
        .PageSetup.LeftMargin = Application.InchesToPoints(0.5)
        .PageSetup.RightMargin = Application.InchesToPoints(0.5)
        .PageSetup.TopMargin = Application.InchesToPoints(0.5)
        .PageSetup.BottomMargin = Application.InchesToPoints(0.5)
        .Columns("A:A").ColumnWidth = 8: .Columns("B:B").ColumnWidth = 18
        .Columns("C:C").ColumnWidth = 25: .Columns("D:D").ColumnWidth = 14
        .Columns("E:E").ColumnWidth = 15: .Cells.Font.Size = 12
End With
sh.Range("A8").Resize(UserForm2.ListBox1.ListCount, 5).Value = UserForm2.ListBox1.List
Lr = sh.Range("A" & Rows.Count).End(xlUp).Row
sh.Range("A8:E" & Lr).Borders.Value = 1
sh.Range("C" & Lr + 2) = "المجمــوع :"
sh.Range("D" & Lr + 2) = UserForm2.T_Total.Value
sh.Range("C" & Lr + 2 & ":D" & Lr + 2).Borders.Value = 1
sh.PageSetup.PrintArea = "A1:E" & Lr + 3
Application.ScreenUpdating = True

sh.PrintOut

End Sub

 

[مهند الزيدي]

شكرا لك اخي العزيز تم المطلوب وفقك الله لكل خير

[أبو حنــــين]

تمت و الحمد لله

[أبو قاسم]

7 ساعات مضت, أخوكم في الله said:

السلام عليكم

كلما تمت التجربة كلما قلت الاخطاء

بالفعل لم اضع الاجمالي في آخر صفحة الطباعة

امسح الموديل 2 و انسخ مكانه الكود التالي

 

Sub iPageSetup()

Application.ScreenUpdating = False
Dim sh As Worksheet, Lr As Integer, Last As Integer
Set sh = Sheets("sPrint")
With sh
Last = .Range("A" & Rows.Count).End(xlUp).Row + 1
.PageSetup.PrintArea = ""
.Range("A8:E" & Last).Borders.Value = 0
'-----------------------------------------------------
.Range("A8:E" & Last).ClearContents
'-------------------------------------------------------
        .PageSetup.LeftMargin = Application.InchesToPoints(0.5)
        .PageSetup.RightMargin = Application.InchesToPoints(0.5)
        .PageSetup.TopMargin = Application.InchesToPoints(0.5)
        .PageSetup.BottomMargin = Application.InchesToPoints(0.5)
        .Columns("A:A").ColumnWidth = 8: .Columns("B:B").ColumnWidth = 18
        .Columns("C:C").ColumnWidth = 25: .Columns("D:D").ColumnWidth = 14
        .Columns("E:E").ColumnWidth = 15: .Cells.Font.Size = 12
End With
sh.Range("A8").Resize(UserForm2.ListBox1.ListCount, 5).Value = UserForm2.ListBox1.List
Lr = sh.Range("A" & Rows.Count).End(xlUp).Row
sh.Range("A8:E" & Lr).Borders.Value = 1
sh.Range("C" & Lr + 2) = "المجمــوع :"
sh.Range("D" & Lr + 2) = UserForm2.T_Total.Value
sh.Range("C" & Lr + 2 & ":D" & Lr + 2).Borders.Value = 1
sh.PageSetup.PrintArea = "A1:E" & Lr + 3
Application.ScreenUpdating = True

sh.PrintOut

End Sub

 

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

ثانيا ComboBox3 لايظهر في اللستة اذا كان تنسيق تاريخ

طريقة تصميم فورم بحث عن طريق لست بوكس2.rar

تم تعديل أبريل 22, 2016 بواسطه أبو قاسم

[أبو قاسم]

محتاج طباعة حسب تاريخ اليوم

[مهند الزيدي]

السلام عليك أخي العزيز ..

هل من الممكن شرح كيف يمكن تغيير شكل اطار الخلية كما في الكود 

Borders.Value = 1

اي ماهي الارقام لكل تنسيق في ال borders للدلالة على نوع التنسيق في الكود كما في الصورة 

تم تعديل أبريل 22, 2016 بواسطه مهند الزيدي

[أبو حنــــين]

هذه بعض خصائص الخطوط

[مهند الزيدي]

شكرا لك اخي العزيز .... وفقك الله لكل خير