نجوم المشاركات

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

تفضل استاذى الفاضل وائل استبدل الجزء الخاص بالخليه A4 بالتالى اذا كنت عايز تستخدم اسم الشيت يبقى لازم تكتب ("اسم الشيت") Sheets If x = Sheets("users").Range("a4") Then او السطر التالى بفرض ان الشيت المسمى Users هو شيت رقم 3 ( وعلشان تعرف رقمه ممكن من محرر الاكواد شوف الشيت users بجوارة رقم الشيت If x = Sheet3.Range("a4") Then كلا السطرين يؤدو نفس الغرض اعتذر للجميع لقلة تواجدى هذه الايام نظرا لانشغالى واسالكم الدعاء اعتذر ابوالبراء لم ارى مشاركتك الا بعد ما عملت حفظ لا يفتى ومالك بالمدينة تقبل تحياتى

اخى صلاح المصرى كما اشار الاخ وائل الاسيوطى في رابط الشرح للاجابه على سؤالك نعم يمكن بطريقتين اولا بالمجال الديناميكى وهو يزيد او ينقص بزيادة ونقص البيانات من صيغ ادارة الاسماء تحرير سمى المجال باسم يدل على العمل او باختيارك ثم في refer to ضع المعادله =OFFSET(Sheet1!$A$1,0,0,COUNTA(Sheet1!$A:$A),4) الطريقة الاسهل حدد بياناتك واضغط ctr+t لانشاء جدول جديد واختار الجدول كمصدر للبيانات ويمكن تحديث التقرير تلقائىه بالكود التالى Sub RefreshPivotTables() Dim pivotTable As PivotTable For Each pivotTable In ActiveSheet.PivotTables pivotTable.RefreshTable Next End Sub

السلام عليكم ..جزاكم الله خيراً أخي الحبيب أبو أسيل تم التثبيت بفضل الله ثم بفضلكم تقبل تحياتي العطرة.

جرب ياريس Sub Yasser() Dim x As String x = InputBox("من فضلك فم بادخال كلمة المرور.", "Password Required") If x = users.Range("a4").Value Then users.Visible = xlSheetVisible users.Select Else MsgBox "كلمة المرور خطأ" End If End Sub اكيد دا ملف الصلاحيات

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

السلام عليكم و رحمة الله و بركاته بارك الله فيك أخي محمد أبو صهيب .. فورم ممتاز جزاك الله خيرًا و زادها بميزان حسناتك إحتراماتي

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

أخي الكريم وائل لما لم ترفق ملف ؟ لما لم تضع الكود بين أقواس الكود؟! ما هو الخطأ الذي يظهر معك عند النقر على كلمة Debug؟ هل الاسم users الاسم البرمجي لورقة العمل المراد ربط الباسورد بها؟ هل جربت استخدام كلمة Sheets يليها قوس مفتوح ) ثم أقواس تنصيص " ثم اسم ورقة العمل users ثم إغلاق أقواس التنصيص " ثم إغلاق القوس ( ...؟ تقبل تحياتي

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

السلام عليكم اسمي عبدالواجد - ومعنى الواجـد الواجد.. الغنيُّ الذي لا يفتقر، والواجد هو الذي لا يضلُّ عنه شيء، فأحياناً الإنسان لضعفه يقول: بحثت عنه كثيراً فلم أجده، أي احترت في أمري فأين أجده، فاته الشيء غاب عنه، لكنَّ الله سبحانه وتعالى هو الواجد الذي لا يضلُّ عنه شيء، ولا يفوته شيء، الله جلَّ جلاله الواجد.. قال: " هو الذي يجد كلَّ ما يطلبه ويريده ". فالإنسان قد يطلب آلاف الطلبات ولا يجدها، يريد آلاف الأهداف ولا يُحصِّلها، لكنَّ الله سبحانه وتعالى لا يضلُّ عنه شيء ولا يفوته شيء، وهو الذي يجد كلَّ ما يطلبه ويريده ولا يُعوزه شيءٌ من ذلك، ولا يُعجزه شيء ذلكم الله ربُّ العالمين، أي شتَّان بين من يكون عبداً لغير الله وبين من يكون عبداً لله. أما بخصوص الشريط المتحرك / فإذا كان به ارهاق على الملف فلا احتاج اليه ، إنما شيء كمالي ولكن بحثت في المتتدى ووجد ملف للأستاذ البسكري سهل وسريع ، ولكن وجدت صعوبة بالتغيير في الشريط شريط شريط.rar

السلام عليكم ... من رخصة الاستاذ سعيد ... Private Sub Command8_Click() DoCmd.SetWarnings False DoCmd.RunSQL "DELETE table3.id, table3.Classe, table3.Tech, table3.Fees from table3 WHERE(((table3.ID) = [Forms]![table1]![Table2 Subform1]![ID]) And ((table3.Classe) = [Forms]![table1]![Table2 Subform1]![Classe]) And ((table3.Tech) = [Forms]![table1]![Table2 Subform1]![Tech]) And ((table3.Fees) = [Forms]![table1]![Table2 Subform1]![Fees]))" DoCmd.RunSQL "DELETE table2.id, table2.Classe, table2.Tech, table2.Fees from table2 WHERE(((table2.ID) = [Forms]![table1]![Table2 Subform1]![ID]) And ((table2.Classe) = [Forms]![table1]![Table2 Subform1]![Classe]) And ((table2.Tech) = [Forms]![table1]![Table2 Subform1]![Tech]) And ((table2.Fees) = [Forms]![table1]![Table2 Subform1]![Fees]))" DoCmd.SetWarnings True Me.Requery End Sub

حبيبي الغالي ابو يوسف اذا كان هو البرنامج بالفعل يبقي اظن اثناء التحميل سقط امتداده معرفشي ازاي المهم جرب الشرح دا وشوف يمكن ينفع تقبل تحياتي yasser.rar

أخي الغالي وحبيبي في الله أبو القبطان .. الملف سيء !! أيوا سيء !! أيوا زي ما بقولك كدا سيء@@ زعلت ؟؟! حقك عليا ! الملف جيد أيوا جيد .. بقولك جيد واحد هيقول العضو دا شكله مجنون أو عبيط .. هرد أقوله أشكرك ... بس كل واحد له طريقة تفكيره وكل شيخ وله طريقة بالأمس لم أطلع على الملف الجيد بشكل جيد .. لكن أتيحت لي الفرصة أن أطلع عليه فوجدت الأكواد جميلة ولكنها تحتاج لترتيب .. نريد أن نتعود عند إرفاق ملفات بالمنتدى أن تكون الأمور مرتبة ومنطقية .. ويتم إزالة الشوائب منها أولاً بالنسبة للكود في حدث المصنف وجدت أنه نفس الكود في موديول رقم 1 ..فلما التكرار الغير مرغوب فيه؟! يمكن الإبقاء على الكود في الموديول رقم 1 والإشارة إلي اسم الإجراء الفرعي في حدث فتح المصنف باستخدام كلمة Call يليها اسم الإجراء الفرعي ثانياً وجدت كود يخص الفورم في الموديول العادي !! ليس مكانه ثالثاً الكود في الموديول الثاني أعتقد أنه ماكرو مسجل ، وكم أكره شكل أسطر الكود الناتجة عن تسجيل الماكرو .. فهناك شوائب كثيرة فيها غير أن الكود ليس له علاقة بالموضوع ومن ثم يجب إزالة جميع الأكواد من المصنف الخاص بك وإعادة ترتيبها بهذا الشكل (لاحظ أيضاً شكل أسطر الكود وكيف تم تنسيقها ليسهل الإطلاع عليها) ضع الكود التالي في حدث المصنف ThisWorkbook Private Sub Workbook_Open() Call Picture1_Click End Sub والكود التالي يوضع في الموديول رقم 1 Sub Picture1_Click() Dim I As Long, lastRow As Long Dim Name1 As String lastRow = Sheet1.Cells(Rows.Count, 2).End(xlUp).Row For I = 2 To lastRow Cells(I, 4).Interior.ColorIndex = xlNone Cells(I, 4).Font.ColorIndex = xlAutomatic Cells(I, 4).Font.Bold = False If Cells(I, 4) = Date Then With UserForm1.ListBox1 .AddItem .List(.ListCount - 1, 0) = Sheet1.Cells(I, 1).Text .List(.ListCount - 1, 1) = Sheet1.Cells(I, 2).Text .List(.ListCount - 1, 2) = Sheet1.Cells(I, 3).Text .List(.ListCount - 1, 3) = Sheet1.Cells(I, 4).Text .List(.ListCount - 1, 4) = Sheet1.Cells(I, 5).Text .List(.ListCount - 1, 5) = Sheet1.Cells(I, 6).Text .List(.ListCount - 1, 6) = Sheet1.Cells(I, 7).Text .List(.ListCount - 1, 7) = Sheet1.Cells(I, 8).Text End With Cells(I, 4).Interior.ColorIndex = 3 Cells(I, 4).Font.ColorIndex = 2 Cells(I, 4).Font.Bold = True End If Next I UserForm1.Show End Sub والكود التالي يوضع في حدث الفورم Private Sub CommandButton1_Click() End End Sub Private Sub Image1_Click() UserForm1.PrintForm End Sub Private Sub Image2_Click() UserForm1.PrintPreviewForm End Sub Private Sub UserForm_Activate() lblDate.Caption = Date End Sub أرجو ألا أكون قد أزعجتك .. ولكني أحب أن أرى الأشياء في أجمل صورة لها ، وحتى يستفيد منها من أرد الاستفادة لا أن تكون مجرد ملف مرفق يلقى به في مكانٍ ما ويطويه النسيان أردت الاستفادة للجميع من الملف الرائع ولكن بصورة أفضل تقبل تحياتي

تم اضافة الاصدار الخامس - سبتمبر 2012 إسم الملف: مُجمِع البيانات للاكسيل - Excel Data Collector أضيف للمكتبة بواسطة: محمد طاهر تاريخ الإضافة: 12 Sep 2011 القسم فى المكتبة: قسم الإكسيل هذا التطبيق يقوم بتجميع البيانات من كافة ملفات الاكسيل الموجودة فى مجلد معبن وفق مجال الخلايا الذي يتم تحديده خطوات الاستخدام ضع كافة الملفات المطلوب تجميع البيانات منها فى مجلد واحد حدد مسار المجلد و مجال الخلايا المطلوب تجميع البيانات منها قم بتشغيل التطبيق من زر Get Data ، سيتم تجميع البيانات من كافة الملفات فى ملف جديد ميزة اضافية اذا اردت استخدام التطبيق اكثر من مرة على عدة مجلدات ، فتوفيرا لخطوات اختيار المجلد المستهدف ، يمكن تحديد مجلد بدء الاختيار الافتراضي، ليبدا اختيار المجلدات منه فى كل مرة أثناء استخدام الملف بدلا من البدء من My Computer . و يمكن عمل ذلك بتحرير الخلية مباشرة ، فمثلا نكتب المسار d:\data الاصدار الثاني إضافة امكانية تحديد ورقة عمل محددة داخل الملفات باسمها ، اكتب اسم ورقة العمل او اتركها خالية للعمل افتراضيا على ورقة العمل الاولي فى جميع ملفات المصدر الاصدار الثالث تم اضافة المزايا التالية : 1- استخدام نموذج بدل من الازرار المباشرة نظرا لاضافة خيارات عديدة ، و يتم تسجيل مسار المجلد و اسم ورقة العمل و المجال المطلوب للخلايا المراد تجميع البيانات منها فى الحقول المناظرة. 2- فى حال عدم تسمية ورقة العمل سيتم التجميع من ورقة العمل الاولي فى جميع المفات داخل المجلد. 3- اضافة تلميحات tips بالعربية عند الوقوف بالماوس على الحقل للتوضيح. 4-امكانية اختيار تجميع البيانات فقط أو تجميع البيانات و التنسيق معا من ملفات المصدر الموجودة داخل المجلد المختار. 5- امكانية اختيار اظهار او اخفاء امتداد اسماء الملفات عند وضعها كعنوان للبيانات فى الملف التجميعي. 6- امكانية السماح بتكرار اسم الملف عند وجود اكثر من عمود يتم استخراجه من نفس الملف ، او الاكتفاء بخلية واحدة مع دمج العناوين. 7- اضافة اطار خارجي يوضح بيانات كل ملف الإصدار الرابع - تنقيح و ترتيب داخلي للكود - تعديل واجهة الاستخدام - امكانية استخراج البيانات دون فتح ملفات المصدر كخيار اضافى ، على أن يتم ذلك دون جلبها بنفس تنسيق المصدر. و هنا يوجد خياران للتشغيل الخيار الأول ، و هو الخيار الأصلي Get Data While Opening Files و به كافة الامكانيات فى الاصدار الثالث ، و امكانية عدم تحديد اسم ورقة العمل ليعمل على أول ورقة عمل فى الملفات الخيار الثاني و المضاف فى هذا الاصدار كخيار اضافي يستخدم عند الحاجة و به بعض المحدودية Get Data Without Opening Files و هنا يتم استخراج البيانات دون فتح ملفات المصدر ، و ذلك بهدف تسريع الاستخدام فى حالة الملفات الكثيرة و كبيرة الحجم و هنا خيار جلب التنسيق للخلايا غير مفعل ، و ايضا لابد من تحديد اسم ورقة العمل و الخيار كله اضافى حيث يغطي الخيار الأول خيارات أكثر الإصدار الخامس تم اضافة خيار امكانية استخراج البيانات بطريفة افقية ( بيانات الملفات المختلفة تظهر فى صفوف ) كخيار بديل و ليس رأسيا فقط ( أعمدة) مثل الاصدارات السابقة إضغط هنـــــــــــا لتنزيل الملف

السلام عليكم ورحمة الله وبركاته إخواني الأحباب الأعزاء والمقربين من قلبي أقدم لكم اليوم موضوع مفيد إن شاء الله ، ألا وهو مقارنة عمودين وسيكون باستخدام التنسيق الشرطي ، لتلوين القيم المميزة أو القيم الفريدة في العمودين ، وكذلك لتلوين القيم المتشابهة في كلا العمودين أترككم مع الفيديو (ولا تنسونا من صالح دعائكم ..فبفضل الله ثم بفضل دعائكم نحيا في هذه الدنيا) كما لا تنسونا من اللايكات .. رابط الفيديو .. مرفق لكم ملف الشرح للتدريب عليه تقبلوا تحياتي ..أخوكم أبو البراء Compare Lists.rar

السلام عليكم ورحمة الله وبركاته إخواني الأحباب سبق أن قمنا بكسر حماية محرر الأكواد بدون برامج .. الآن مع كسر حماية أوراق العمل بالاستعانة ببرنامج صغير الحجم اسمه XML Marker وهو برنامج للتعديل على ملفات الـ XML وهو مرفق في الموضوع ... أترككم مع الفيديو ..عسى أن تستفيدوا منه إن شاء الله (ومتنسوش اللايكات !!) تقبلوا تحيات أخوكم أبو البراء xmlmarker_2_2_setup.rar

السلام عليكم ورحمه الله وبركاته سؤال عن طريقه تجميع علامات الصح هل يمكن ذلك وشكرا تجميع علامه صح.rar

ياراجل قول كلام غير دا انا جربته في الملف نفسه وشغال يبقي ترفق المثال بقي زي ما قال الاخوة عشان نقدر نساعد المهم ادي المثال وشغال تمام كلمة الدخول123 صفحة اليوزرز 999 صلاحيات - Copy.rar

وعليكم السلام أخي محمد ، وعذرا على التأخير 1. الزرين عندك بنفس الاسم ، فما عرفت ايهم يعمل ماذا 2. في كود الزرين ، انت قلت ان ملفات الـ pdf موجودة في Path1 = Application.CurrentProject.Path & "\" file1 = Path1 & Me.name_morfke بينما في الصورة التي ارفقتها ، فعندك "مسار فولدر الحفظ" ، فهل الاثنان نفس الشئ ، وإلا ، فرجاء تغيير مسار الملفات في الكود اعلاه ، جعفر

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

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

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

http://excelpivots.com/excel/pivot_table_expanding_data_ranges/ الينك دا في شرح طلبك

جرب هذا الماكرو Sub sum_of_Many_sheets1() Dim My_sheet As Worksheet Set My_sheet = Sheets("total") x = Sheets.Count My_sheet.Cells(7, 3).Activate For i = 0 To 4 K = 0: s = 0: t = 0 For j = 2 To x t = Sheets(j).Cells(9, 42 + i).Value ' My_sheet.Cells(K + 1, 4) = t K = K + 1 s = s + t Next ActiveCell = s ActiveCell.Offset(1, 0).Activate Next ActiveCell.Delete End Sub

هي الصورة نفسها التي ارفقتها لك

لا يوجد داعي لعمل قسم جديد للبرمجة هو فين المبرمجين ياعم دا يدوب واحد مبتدئ العملية مش مستاهلة الان هو مجرد موضوع ولما ربنا يكرمنا ونحترف نبقي ندور نعمل قسم ؟؟؟؟؟؟ تقبل تحياتي بخصوص النسخة مش هتفرق كل النسخ زي بعض من 2010 2015 قريبين من بعض عادي حتى الاصدارات نفس الشئ ولكن اختلاف طفيف في المظهر العام وان كان ولا بد انا بشتغل على 2012

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

جرب الكود بهذا الشكل ..تم تعديل الجزء الأول إذا لم يعمل معك يرجى وضع صورة للسطر الأصفر الذي تظهر فيه المشكلة Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Column = 3 Then Call kh_Show_UFormChang1 End If '********************************************************** If Target.Column = 5 Then Target.Value = Date Selection.NumberFormat = "yyyy/mm/dd" Target.Offset(0, 1).Select End If If Target.Column = 6 Or Target.Column = 8 Then Target.Value = Target.Offset(-1, 0) Target.Offset(0, 1).Select End If ThisRow = Target.Row If Target.Column = 7 And Range("f" & ThisRow) = "قيد يومية" Then YESNO = MsgBox("رقم المستند جديد ؟", vbYesNo + vbCritical, "Caution") Select Case YESNO Case vbYes Target.Value = Range("f4").Value + 1 Target.Offset(0, 1).Select Case vbNo Target.Value = Range("f4").Value Target.Offset(0, 1).Select End Select End If If Target.Column = 7 And Range("f" & ThisRow) = "استلام شيك" Then YESNO = MsgBox("رقم المستند جديد ؟", vbYesNo + vbCritical, "Caution") Select Case YESNO Case vbYes Target.Value = Range("g1").Value + 1 Target.Offset(0, 1).Select Case vbNo Target.Value = Range("g1").Value Target.Offset(0, 1).Select End Select End If If Target.Column = 7 And Range("f" & ThisRow) = "قبض نقدي" Then YESNO = MsgBox("رقم المستند جديد ؟", vbYesNo + vbCritical, "Caution") Select Case YESNO Case vbYes Target.Value = Range("g2").Value + 1 Target.Offset(0, 1).Select Case vbNo Target.Value = Range("g2").Value Target.Offset(0, 1).Select End Select End If If Target.Column = 7 And Range("f" & ThisRow) = "صرف نقدي" Then YESNO = MsgBox("رقم المستند جديد ؟", vbYesNo + vbCritical, "Caution") Select Case YESNO Case vbYes Target.Value = Range("g3").Value + 1 Target.Offset(0, 1).Select Case vbNo Target.Value = Range("g3").Value Target.Offset(0, 1).Select End Select End If If Target.Column = 7 And Range("f" & ThisRow) = "صرف شيك" Then YESNO = MsgBox("رقم المستند جديد ؟", vbYesNo + vbCritical, "Caution") Select Case YESNO Case vbYes Target.Value = Range("g4").Value + 1 Target.Offset(0, 1).Select Case vbNo Target.Value = Range("g4").Value Target.Offset(0, 1).Select End Select End If End Sub وبعدين تعالى هنا قولي : هو أنا لما بطلب فتح موضوع جديد لكل طلب ، بطلب شيء صعب ولا مستحيل .. أنا بطلب كدا من باب النصيحة لأن من خلال خبرتي في التعامل مع الموضوعات لاحظت ضعف في الاستجابة للطلبات الفرعية غير لما يكون الموضوع جديد وفريش .. أنا واحد من الناس لا أنتبه كثيراً للطلبات الفرعية ... أرجو أن تكون الصورة واضحة .. فكوني بطلب موضوع جديد لكل طلب مش فزلكة مني ، لكن لمصلحة السائل قبل أي شيء آخر وفي النهاية كل واحد له مطلق الحرية لفعل ما يريد ولن أطلب فتح موضوع جديد مرة أخرى إذا كان هذا يضايق الأعضاء ، وسأدعهم يفعلوم ما يريدون ..

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

ابا يوسف انت عندك ٢٠ اعجاب فقط ليه انا عندى ٢٨ لا اعلم ما هذا ولكن اعجابتى بتخلص بسرعه برضه ابو البراء جزاك الله كل خير احبك فى الله آمل أن تجدنى عند حسن ظنك اخى الغالى

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

جرب هذه المعادلة في الخلية A12 =CHOOSE((SUM($A$2:$A$11)=1)+1,"مرفوض",SUM($A$2:$A$11))

أخي الحبيب سعيد الفكرة والله دائماً في وضوح الطلب .. شفت لما الطلب أصبح واضح كما في المشاركة الأخيرة .اتحلت بتكة أبسط مما تتخيل .. بالنسبة لطلبك الثاني السيريال نمبر هسيبك مرة تانية توضح بالتفصيل عشان تكون الأمور واضحة وغداً إن شاء الله سأطلع على الموضوع مرة أخرى فقد حان وقت النوم تصبح على السرير وعلى خير إن شاء الله تقبل تحياتي جرب تضع هذا السطر في نهاية الكود في آخر سطر قبل End Sub Range("C2").Value = Range("C2").Value + 1 أرجو أن يكون المطلوب إن شاء الله

أجمل وأجمل يا أخي الغالي .. بارك الله فيك وجزاك الله كل خير على هذه المساهمات الرائعة بحق واااااصل معنا بلا فواصل

عن طريقة المعادلة OFFSET =OFFSET($A$6;-(ROW(A1)-1);0)

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

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله أقدم لكم كود متميز جداً .. كود في منتهى الروعة .. إن شاء الله تستفيدوا منه أقصى استفادة .. الكثير منا يبحث عن موضوع فصل الناجحين والراسبين .. ها أنا أقدم لك على طبق من كود : الكود الذهبي الذي سيقوم بذلك بمنتهى السهولة واليسر .. هذا هو الشكل العام للكود Sub SplitFilteredData() 'الإعلان عن المتغيرات Dim MySheet As Worksheet Dim MyRange As Range Dim UList As Collection Dim UListValue As Variant Dim I As Long 'تخصيص ورقة العمل النشطة Set MySheet = ActiveSheet 'إذا لم تحتوي ورقة العمل على فلترة يتم الخروج من الإجراء الفرعي If MySheet.AutoFilterMode = False Then Exit Sub End If 'حدد العمود الذي يحتوي على البيانات المراد عمل تصفية لها Set MyRange = Range(MySheet.AutoFilter.Range.Columns(5).Address) 'إنشاء كائن تجميعي Set UList = New Collection 'وضع قيم في الكائن التجميعي بالقيم الفريدة أي الغير مكررة فقط On Error Resume Next For I = 2 To MyRange.Rows.Count UList.Add MyRange.Cells(I, 1), CStr(MyRange.Cells(I, 1)) Next I On Error GoTo 0 'حلقة تكرارية للقيم الموجودة داخل الكائن التجميعي For Each UListValue In UList 'حذف أية أوراق عمل تم إنشاءها من قبل On Error Resume Next Application.DisplayAlerts = False Sheets(CStr(UListValue)).Delete Application.DisplayAlerts = True On Error GoTo 0 'عمل تصفية لمطابقة القيمة الحالية MyRange.AutoFilter Field:=5, Criteria1:=UListValue 'نسخ النطاق الذي تم تصفيته إلى ورقة عمل جديدة MySheet.AutoFilter.Range.Copy Worksheets.Add.Paste ActiveSheet.Name = Left(UListValue, 30) Cells.EntireColumn.AutoFit 'إعادة الحلقة التكرارية مع قيمة أخرى Next UListValue 'الذهاب للصفحة التي تحتوي على البيانات وإزالة الفلترة MySheet.AutoFilter.ShowAllData MySheet.Select End Sub في الفيديو شرح لكيفية استخدام الكود .. ومرفق في الموضوع الملف الذي تم الشرح عليه إليكم رابط الفيديو لا تنسونا من صالح دعائكم ، ولا تنسوا اللايكات في اليوتيوب ... تقبلوا تحيات أخوكم أبو البراء Split Filtered Data VBA.rar Split Filtered Data VBA V2.rar

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

أخي الكريم جرب الكود بهذا الشكل Sub ConvertProcess() Dim I As Long, Sh As Worksheet Dim strbinnum, BitValue, BinNumSize, PlaceValue, lngBaseX Dim intNumber, intRemainder, strRemainder, strOctalNumber Application.ScreenUpdating = False For Each Sh In ThisWorkbook.Sheets With Sh .Range("F2:J10000").ClearContents For I = 2 To .Cells(Rows.Count, 5).End(xlUp).Row .Cells(I, 6).Value = RemovePeriods(.Cells(I, 5).Text) + 0 .Cells(I, 7).Value = DecimalToBinary(.Cells(I, 6)) .Cells(I, 8).Value = BinaryToOctal(.Cells(I, 7).Text) .Cells(I, 9).Value = SumDigits(.Cells(I, 8)) .Cells(I, 10).Formula = "=IF(" & .Cells(I, 8).Address & "="""","""",MOD(" & .Cells(I, 8).Address & "-1,9)+1)" .Cells(I, 10).Value = .Cells(I, 10).Value Next I End With Next Sh Application.ScreenUpdating = True End Sub Public Function RemovePeriods(ByVal Txt) Application.Volatile If TypeOf Txt Is Range Then Txt = Txt.Text End If RemovePeriods = Replace(Txt, ".", "") End Function Public Function DecimalToBinary(DecimalNum As Long) As String Dim Tmp As String Dim N As Long N = DecimalNum Tmp = Trim(Str(N Mod 2)) N = N \ 2 Do While N <> 0 Tmp = Trim(Str(N Mod 2)) & Tmp N = N \ 2 Loop DecimalToBinary = Tmp End Function Function BinaryToOctal(strbinnum As String) Dim BitValue As String, BinNumSize As Long, PlaceValue, lngBaseX As Long, intNumber As Long, intRemainder As Long, strRemainder As String, strOctalNumber As String BinNumSize = Len(strbinnum) For PlaceValue = 0 To BinNumSize - 1 BitValue = Mid(strbinnum, BinNumSize, 1) BinNumSize = BinNumSize - 1 lngBaseX = (2 ^ PlaceValue * CInt(BitValue)) + lngBaseX Next PlaceValue intNumber = lngBaseX Do While intNumber >= 1 intRemainder = intNumber Mod 8 strRemainder = CStr(intRemainder) intNumber = intNumber \ 8 strOctalNumber = strRemainder & strOctalNumber Loop BinaryToOctal = strOctalNumber End Function Function SumDigits(Number) Dim I As Long For I = 1 To Len(Number) SumDigits = SumDigits + Val(Mid(Number, I, 1)) Next I End Function وإليك الملف المرفق مطبق فيه الكود مع ملاحظة أن تم تنسيق عمود G كنص Decimal & Binary & Octal Conversion For All Sheets YasserKhalil.rar

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

وهذا المرفق الأول Emp_Database.rar

السلام عليكم ورحمة الله تعالى وبركاته أحبائي وأساتذتي الأفاضل أقدم لك هذه التجميعية البسيطه ليستفيد بها المبتدئ والمحترف تجمعية تحت عنوان تغذية القائمة المنسدلة خاصة بالفورم (ComboBox) بمدى ديناميكي أولا: نقوم بإنشاء فورم وندرج به قائمة منسدلة (ComboBox1) ثانيا : نفتح محرر الاكواد View Code) ثالثا: من نافذه المحرر نختر حدث بداية التشغيل الفورم UserForm_Initialize Private Sub UserForm_Initialize() End Sub نقوم بوضع المتغير التالي الخاص بتحديد ورقة العمل وهم أمر مهم جدا Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select End Sub نأتي الأن إلى الأكواد الخاصة بتغذية القائمة المنسدلة ملاحظه جميع الأكواد الخاصة بالتغذية أنا إخترت العمود الأول وبداية التغذية من الخلية A2 ولكم حرية التغيير الكود رقم 1 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Range("A2", Range("A" & Rows.Count).End(xlUp)).Name = "Dynamic" Me.ComboBox1.RowSource = "Dynamic" End Sub الكود رقم 2 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Me.ComboBox1.RowSource = Range("B2", Range("B65536").End(xlUp)).Address End Sub الكود رقم 3 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Me.ComboBox1.RowSource = ("A2:A") & ws.Cells(Rows.Count, "A").End(xlUp).Row End Sub الكود رقم 4 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Me.ComboBox1.List = Range("A2:A" & Cells(Application.Rows.Count, 1).End(xlUp).Row).Value End Sub الكود رقم 5 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Dim FR As Integer, LR As Integer With ws LR = .Range("A2").End(xlDown).Row For FR = 2 To LR Me.ComboBox1.AddItem .Range("A" & FR) Next FR End With End Sub الكود رقم 6 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Dim R As Integer With ws For R = 2 To .Range("A" & .Rows.Count).End(xlUp).Row If .Range("A" & R) <> "" Then Me.ComboBox1.AddItem .Range("A" & R) End If Next R End With End Sub الكود رقم 7 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Dim LR As Long LR = ws.Cells(Rows.Count, "A").End(xlUp).Row myList = ws.Range("A2:" & "A" & LR) Me.ComboBox1.List = myList End Sub الكود رقم 8 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Dim LR As Long LR = ws.Range("A" & Rows.Count).End(xlUp).Row Set myList = ws.Range("A2:A" & LR) Me.ComboBox1.List = myList.Value End Sub الكود رقم 9 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Dim LR As Long With ComboBox1 LR = ws.Cells(Rows.Count, 1).End(xlUp).Row .List = ws.Range(ws.Cells(2, 1), ws.Cells(LR, 1)).Value End With End Sub الكود رقم 10 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Dim myList As Range For Each myList In ws.Range("A2").SpecialCells(xlConstants) With Me.ComboBox1 .AddItem myList.Value .List(.ListCount - 1, 1) = myList.Offset(0, 1).Value End With Next End Sub الكود رقم 11 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Dim i As Integer, iMin As Integer, iMax As Integer iMin = 2: iMax = Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row For i = iMin To iMax ComboBox1.List = Range(Cells(iMin, 1), Cells(iMax, 1)).Value Next i End Sub الكود رقم 12 من إدارة الأسماء نختر جديد الإسم انت حر فيما تختار أنا إخترت MyRange في خانة يشير إلى نقوم بوضع هذه المعادلة =OFFSET(Sheet1!$A$2;;;COUNTA(Sheet1!$A$2:$A$10000);1) في الفورم نقوم بوضع الكود التالي Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Me.ComboBox1.RowSource = "Myrange" End Sub الكود رقم 13 كود تغذية القائمة المنسدلة بدون فراغات Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Dim cell As Range With ws For Each cell In .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row) If Not IsEmpty(cell) Then ComboBox1.AddItem cell.Value Next cell End With End Sub الكود رقم 14 كود تغذية القائمة المنسدلة بدون فراغات وبدون تكرار Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Dim I As Integer Dim Valeurs As Variant Dim sDic As Object Set sDic = CreateObject("Scripting.Dictionary") With ws Valeurs = .Range("A2:A100").Value For I = LBound(Valeurs) To UBound(Valeurs) If Not IsEmpty(Valeurs(I, 1)) Then sDic(Valeurs(I, 1)) = "" Next I End With If IsArray(Valeurs) Then Me.ComboBox1.List = sDic.keys End Sub وفي الأخير أتمنى هذه التجمعية المتواضعة أن تفيدكم أعرف أن أستاذي القدير حيزعل مني لأني لم أقم بوضع هذه الاكواد في تجمعية مكتبه المنتدى ووضعها في موضوع منفصل حتى يكون هذا الموضوع مرجعا لكل من يريد التعلم بأبسط الطرق أستاذي القدير وحقك عليا تقبلو تحياتي لا تنسونا بخالص دعائكم

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

السلام عليكم أخي كرار ، هذا معناه انك لم تحدّث الاكسس 2010 اللي تستعمله !! تم حل هذه المشكلة في SP1 ، والان التحديثات وصلت الى SP2 (وطبعا ما تقدر تنصب SP2 بدون ما تكون منصب SP1). رابط انزال SP1 https://www.microsoft.com/en-us/search/result.aspx?q=Service+Pack+1+for+Microsoft+Office+2010&form=dlc رابط انزال SP2 http://pcsupport.about.com/od/keepingupwithupdates/a/office-service-pack.htm واثناء تنزيل التحديثات من الانترنت ، اقرا الرابط التالي ، وفيه معلومة عن التحديثات ومعلومات اخرى: http://www.officena.net/ib/topic/65568-تفعيل-ضغط-القاعدة-عند-الاغلاق/?do=findComment&comment=426819 جعفر

حياك الله اخي الكريم انا فهمت تقريبا فهمت سؤالك ولكن لم افهم محتوى القاعدة تبعك .. هنا مثال في المرفق على ماركة السيارة وانواعها .. مثلا لو اخترت تويوتا يظهر لك السيارات من انتاج شركة تويوتا ... ولا يظهر السيارات المنتجة من شركات اخرى مثل فورد ونيسان وغيرها .. اذا كان فهمي لسؤالك صحيح طبق ما في المثال وكفى .. وفقنا الله واياك cars.rar

السلام عليكم ورحمة الله وبركاته ممكن المساعدة فى عمل برنامج مسئول السيارات والواقود 1 إدخال جميع بيانات المركبات التابعة للشركة مثل رقم اللوحة، رقم السيسي ، رقم الموتور، النوع، الموديل، لون السيارة ، نوع الرخصة ،تاريخ بداية الرخصه ، تاريخ نهاية الرخصة ، تكلفة الرخصة ، نوع الوقود ، التخصبص ، اسم السائق،ملاحوظات وغيرها من البيانات 2 إدخال جميع الخدمات والإصلاحات التي تم تقديمها للمركبة مثل غيار الزيت، البريكات، تغيير الإطارات، الوقود، المخالفات وغيرها، مع تواريخ هذه الخدمات. 3 التذكير بشكل آلي بتاريخ الخدمات التي يجب تقديمها لكل مركبة مثل غيار الزيت، تغيير الإطارات، الترخيص وغيرها حسب عدد الكيلومترات المقطوعة أو حسب التاريخ. 4 إدخال قراءة العداد لكل مركبة يومياً لمعرفة المسافة التي قطعتها. 5 اظهار العداد السابق عند تمويل السيارة بالوقود 6 إدخال تفاصيل أوامر الحركة للمركبات مثل: التاريخ، ساعة الخروج، ساعة العودة، الجهة، السائق. 7 طباعة العديد من التقارير لكل مركبة لمعرفة المسافة التي قطعتها وتكاليف الخدمات التي قدمت لها ومقارنتها مع المركبات الأخرى. التقارير يتضمن النظام تقارير متنوعة مثل: ·تقرير الصيانات المتوقعة ·تقرير الصيانات المتأخرة ·تقرير با والسيارات التي لم تدخل الصيانة ·تاريخ كل سيارة ·تقرير حركة كل سيارة ·تقارير بالوقود المنصرف =نوع الوقود+الكمية + العداد اول الفترة + العداد اخرالفتره +المسافه+ك/م+التكلفة +التخصيص +اسم السائق تقريرالوقود شهرى+ربع سنوى_نصف سنوى+سنوى ·تقارير الزيوت =الكمية + التكلفة سنوى ·كشف بالمصاريف واجمالياتها 8 يكون هناك مستخدم واحد لديه كافة الصلاحيات من حذف وأضافة ويوزع الصلاحيات على المستخدمين الاخرين 9 واجهة مستخدم باللغة العربية البرنامج مهم جدا فى مجال عملى ولكم جزيل الشكر

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

شوفولي هالبرامج إشي من الآخر بس والله حاب أسمع تعليقاتكم بدي دعمكم و لسى في كمان كثيييييييييييييييييييييييييييييييير FormsAndReports2000.zip PrintCurrentRecord2000.zip selectionfromcombobox2000.zip MsgBoxMove2000.zip Dialog.zip 2ListBox2000.zip Fatoorh2000.zip IIF2000.zip name2002.zip TreeView2000.zip

شوفولي هالبرنامج و إدعولي وما بدي أذكركم هاي برامج مجمعة من مواقع ومنتديات ، يعني مش أنا إلي عاملها وبشكر أصحاب هذه البرامج لأنها راح تكون مفيدة للجميع إنشاء الله wzbackup.zip