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

السلام عليكم اخوانى ورحمة الله وبركاته اليوم أقدم لكم كودا تستطيع من خلاله حماية الشيت ( بكلمة سر أو بدون ) مع ترك نطاق محدد مسموح للمستخدم بتعديله الطريقة التى أعتمد عليها AllowEditRanges والتى تسمح لمستخدمى اكسل التعديل فى نطاقات محددة رغم وجود حماية على الشيت لاحظ أيضا أنه يمكن عمل رقم سرى خاص بالنطاق المسموح بالتعديل عليه بخلاف الرقم السرى الخاص بحماية الشيت ان وجد . الكود وعليه الشرح وبعض الملاحظات : Sub ProtectSheetExceptRange() ' Protect ActiveSheet , but allow user edit Range("A1:A4,B1:D1") ' By Mokhtar 11/10/2015 On Error Resume Next ' فى حالة حدوث خطأ تجاهله وانتقل للأمر التالى ' تحديد اسم الزر المشغل للكود فى حالة حماية الشيت النشط With ActiveSheet.Shapes("Rounded Rectangle 1").TextFrame2.TextRange.Characters If .Text = "Protect ActiveSheet Except" Then .Text = "UnProtect ActiveSheet " ' حذف النطاق الاول المسموح بالتعديل فيه فى الشيت ActiveSheet.Protection.AllowEditRanges(1).Delete ' تحديد اسم و مدى النطاق المراد التعديل فيه أثناء حماية الشيت ActiveSheet.Protection.AllowEditRanges.Add Title:="Protected Range", Range:=Range("A1:A4,B1:D1") ' فى حالة الرغبة فى حماية النطاق المراد التعديل عليه برقم سرى بخلاف الرقم السرى الخاص بحماية الشيت ' ActiveSheet.Protection.AllowEditRanges.Add Title:="Protected Range", Range:=Range("A1:A4,B1:D1"), Password:=123 ' حماية الشيت بدون كلمة سر ActiveSheet.Protect ' حماية الشيت بكلمة سر ' ActiveSheet.Protect Password:=123 ' تعريف المستخدم بالنطاق المسموح بالتعديل فيه With ActiveSheet.Protection.AllowEditRanges.Item(1) MsgBox "ActiveSheet is Protecting" & vbNewLine & "Except Range : " & .Range.Address & vbNewLine & vbNewLine & "Regards ...Mokhtar " End With Else ' اذا لم يكن هذا فان ' فك حماية الشيت المحمى بدون كلمة سر ActiveSheet.Unprotect ' فى حالة فك حماية الشيت المحمى بكلمة سر ' ActiveSheet.Unprotect Password:=123 ' اسم الزر المشغل للكود فى حالة عدم حماية الشيت النشط .Text = "Protect ActiveSheet Except" End If End With End Sub تفضلوا المرفق وأتمنى أن تستفيدوا به فى أكوادكم وبرامجكم . تحياتى Protect Sheet Expect Range .rar

السلام عليكم ورحمة الله أستاذنا الغالى طريقة الموضوع تعجبنى فهى تجعل الطالب يبحث عن المعلومة والاستاذ يقيم و اسمح لى أستاذى بأن أشارك بهذه الطريقة : ضع الكود الكود التالى فى ملف الأستاذ سليم اللى هو 5 ميجا Option Explicit Sub ExcelDiet() Dim j As Long Dim k As Long Dim LastRow As Long Dim LastCol As Long Dim ColFormula As Range Dim RowFormula As Range Dim ColValue As Range Dim RowValue As Range Dim Shp As Shape Dim ws As Worksheet Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next For Each ws In Worksheets With ws 'Find the last used cell with a formula and value 'Search by Columns and Rows On Error Resume Next Set ColFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious) Set ColValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious) Set RowFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious) Set RowValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious) On Error GoTo 0 'Determine the last column If ColFormula Is Nothing Then LastCol = 0 Else LastCol = ColFormula.Column End If If Not ColValue Is Nothing Then LastCol = Application.WorksheetFunction.Max(LastCol, ColValue.Column) End If 'Determine the last row If RowFormula Is Nothing Then LastRow = 0 Else LastRow = RowFormula.Row End If If Not RowValue Is Nothing Then LastRow = Application.WorksheetFunction.Max(LastRow, RowValue.Row) End If 'Determine if any shapes are beyond the last row and last column For Each Shp In .Shapes j = 0 k = 0 On Error Resume Next j = Shp.TopLeftCell.Row k = Shp.TopLeftCell.Column On Error GoTo 0 If j > 0 And k > 0 Then Do Until .Cells(j, k).Top > Shp.Top + Shp.Height j = j + 1 Loop If j > LastRow Then LastRow = j End If Do Until .Cells(j, k).Left > Shp.Left + Shp.Width k = k + 1 Loop If k > LastCol Then LastCol = k End If End If Next .Range(.Cells(1, LastCol + 1), .Cells(.Rows.Count, .Columns.Count)).EntireColumn.Delete .Range("A" & LastRow + 1 & ":A" & .Rows.Count).EntireRow.Delete End With Next Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub احفظ الملف بصيغة xlsb شوف حجمه ستجد أنه نزل للنصف تقريبا ثم افتح الملف وشغل الكود السابق ثم احفظ الملف واقفله شوف حجم الملف ستجد أنه 32 كيلو بايت اللى حصل هنا أن اكسل أعاد حساب النطاقات الغير مستخدمه فى الملف وحذفها تحياتى

الاخوة الكرام بحمد الله تعالى وفضله قطعاً شوطاُ كبير فى شروحات الفورم على الرابط التالى http://www.officena.net/ib/topic/64037-سلسلة-علمنى-كيف-اصطاد-الفورم-forms/ والان فى صورة عباره عن أسئله للاختبار ارجوا من المهتمين بالموضوع الاجابه عليها حتى يتثنى لنا معرفه هل الشروحات كافيه ؟ هل هى مبسطه ؟ هل يوجد متابعين للموضوع ؟ ما هو مدى الاستفاده مما يقدم ؟ وكمان الفائده الاهم هو انك تشتغل بنفسك وتقوم بالتطبيق على ما قرأته علشان تثبت المعلومه وبعدين الاختبار اوبن بوك ههههههههههههه يعنى نظام تعليم حديث وكل واحد مذاكرته فى دماغه و مسطردته فى ايده و سندوتشاته فى كيسه و مطوته فى جيبه اللى يقولك غششنى قطعه ومحدش يبص فى ورقة زميله ترسل الاجابات على ص ب منتدى اوفيسنا قسم الاكسيل تسلم ليد العضو الصقر والفائز له رحلة عمره (((( اتمنى بجد لو واحد بس اهتم بالموضوع وجاوب صح وقتها هحس انى الشروحات دى لها قيمة وهكمل حتى لو كان واحد بس مستفيد والا يأما أنا فشلت فى الشرح أو ان الموضوع مش ذو اهميه وكدا يبقى اعتذر لكم لما سببته من ازعاج فى هذه الشروحات وراح اطلب من الاداره حذف الموضوع )))) دلوقتى هنوزع ورقة الاسئله وعايز الحل بالطرقتين 1- من خلال الخصائص اثناء التصميم 2- من خلال الاكواد عند فتح الفورم قم بعمل ملف اكسيل جديد وفى الشيت 1 اكتب البيانات كما هى بالعمود D و E ثم قم بتصميم فورم كما هو مبين بالصورة بنفس التنسيق وابدأ الشغل فهل من مشمرون ؟؟؟ اتمنى لكم التوفيق وتقبلوا تحياتى جميعا

استاذى الحبيب / ابويوسف جزاكم الله خيرا فهذا ليس بغريب عليك فأنت دائما وابدا قدوة لنا وصحاب همه عاليه فهى همة الرجال اشكرك مره تانية من اعماق قلبى ولكن اسمح لى بتصحيح الواجب يا غالى انا معنديش رحمه يوجد عشر اسئله كل سؤال بدرجه المطلوب 1:- الدرجة نصف ( صحيح 50% ) لماذا دا سطر الكود الخاص بالتنسيق للتاريخ TextBox1.Text = Format(TextBox1.Text, " yyyy mmm ddd") وطبقا للطلب اللى بالصورة يكون كالتالى TextBox1.Text = Format(TextBox1.Text, " ddd mmm yyyy") لاحظ الفرق بنفسك المطلوب 2:- الدرجة 0 ( لم يتم تنفيذه) لماذا لم تقم بعمل حماية على التكست بوكس ؟؟ المطلوب 3:- الدرجة 1 ( صحيح 100% ) المطلوب 4 :- الدرجة 1 ( صحيح 100% ) المطلوب 5 :- الدرجة 1 ( صحيح 100% ) المطلوب 6 :- الدرجة 1 ( صحيح 100% ) المطلوب 7:- الدرجة 0 ( لم يتم تنفيذه) المطلوب 8:- الدرجة 0 ( لم يتم تنفيذه) المطلوب 9:- الدرجة 0 ( لم يتم تنفيذه) المطلوب 10:- الدرجة 0 ( لم يتم تنفيذه) ملحوظه صغيره هو حضرتك عامل ليه فى الخاصيه ControlSource الخلية d2 ما الفائده منها ( انت عارف دى هتسبب مشكله فين ؟ ) الدرجة النهائيه يا ابويوسف هى 4.5 ( اربعه ونصف فقط ) منتظرك تكمل بكره الباقى هنتظرك ضرورى تقبل تحياتى واحترامى وتقديرى لشخصك الكريم

بسم الله الرحمن الرحيم { يَرْفَعِ اللَّهُ الَّذِينَ آمَنُوا مِنكُمْ وَالَّذِينَ أُوتُوا الْعِلْمَ دَرَجَاتٍ } صدق الله العظيم فبداية أسأل الله العظيم رب العرش العظيم ان ينفعنا واياكم العلم والعمل الصالح مشكلتي واظنها مشكلة اغلب العاملين في مجال البرمجة واكواد الماكرو وغيرها انه اعتمادي دائما عل اكواد منقوله عن الاخوة الكرام المتواجدين في هذا المنتدي الكريم نشكر لهم جهودهم في تلبية واجابة وحل مشاكل الاعضاء فانا لا اريد ان يقتصر عملي علي اكواد اجبر بها برنامجي ان يكون محدود او في نطاق لا يخرج عنه بالعكس اريد برنامج ابتكر له اكواد تلبي جميع احتياجاتي من هنا اريد او معظمنا يريد طريقة توليد اكواد او ابتكار اكواد طريقة تجلعني وتجعلنا نقوم بانشاء برامجنا بدون قيد او اكواد تعيقنا اثناء انشاء برامجنا الخلاصة مذكرات شروحات دروس دورات ايا كانت هي ارجو وضعها هنا لزيادة خبرتنا في هذا المجال الواسع الذي مهما تعلمنا يظل به الكثير والكثير لنعرفه مع خالص تحياتي: ياسر العربي

السلام عليكم جرب هذا الكود ان شاء الله يفي بالغرض Sub Ali_Sort_Tble() Dim Tb As ListObject On Error Resume Next For Each Tb In ActiveSheet.ListObjects With Tb .Range.Sort key1:=.ListColumns(1), order1:=xlAscending, _ Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom End With Next On Error GoTo 0 End Sub

ما رايكم لو اختار المستخدم بنفسه النطاق الذي يسمح به بالكتابة Unprotect Only Choosen Range.zip

إخواني الكرام إليكم الملف يعمل على النسختين 32 بت و 64 بت أرجو أن تستفيدوا منه .. تقبلوا وافر تقدير واحترامي Codes Library v1.9.7.rar

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

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

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

السّلام عليكم و رحمة الله و بركاته ....ونِعْمَ الهدايا أستاذي القدير مختار حسين محمود .. و روعة المفاجآت بارك الله فيك .. جزاك الله خيرًا وزادها بميزان حسناتك ..تشكر يا غالي خالص إحتراماتي

اخى مختار ايه الجمال والحلاوه دى دائما ما تاتى بموضوع مفيد تقبل تحياتى

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

أخى مهند السلام عليكم برجاء تغيير اسم الظهور لديك الى اللغة العربية لسهولة التواصل الشرح : If Not Application.Intersect(Target, Range("B7:B106,F7:F106")) Is Nothing Then If Target.Offset(, 1).Value < CVDate(Date) Then اذا تم تحديد أى خلية فى النطاقين B7: B106 و F7: F106 وكانت قيمة الخلية اللى جنب الخلية المحددة أقل من تاريخ اليوم فإن ........... يعنى مثلا لو كانت الخلية المحددة هى B7 بنشرط شرط وهو أن الخلية اللى جنبها وهى C7 لو التاريخ فيها أقل من تاريخ اليوم فتحدث الحماية واذا لم يتحقق الشرط فان الاكسل يتراجع عن التعديل بالجملة Application.undo طالما أن التاريخ فى C7 أقل من تاريخ اليوم و التعديل لا يكون الا بكلمة السر 123 هتسألنى ازاى أحدد الخلية اللى جنب خلية أخرى : A1 مثلا الخلية التى جنبها B1 ازاى نكتب B1 من غير ما نجيب سيرتها فى الكود : Range("A1").OFFSET(0,1) الجملة دى = B1 , ومعناها ازاحة بمقدار عمود واحد وبدون تغير فى عدد الصفوف للزيادة ابحث عن OFFSET

السلام عليكم هي محاولة مني فاعذرني على تقصيري بقي أن أجعل هذه الكمبوبوكس مقفلة ولأن دوامي يكاد ينتهي آثرت تقديمه على هذه الحال..وكذلك كود العميل.. هي محاولة بدائية تحبو كالطفل الرضيع. والسلام عليكم.eagle

الحمدلله على هذه النعمة وهي حب الجميع للمهندس احمد ان شاء الله احاول التواصل معه وطمأنتكم عنه

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

السلام عليكم ورحمة الله وبركاته إخواني الكرام أحياناً يصادفنا أن يكون حجم الملف كبير جداً مقارنةً بالبيانات الموجودة بداخل الملف .. فقررت عمل موضوع مفتوح يقوم الأعضاء باقتراح طرق لتقليل حجم الملف .. وإليكم ملف للأخ سليم حاصبيا في أحد الموضوعات ..حجم الملف أكثر من 5 ميجا العبد الفقير لله لديه كود خطير يساهم في حل المشكلة ولكن لن أقدمه الآن (كنوع من التشويق ) في انتظار مشاركاتكم القيمة والمساهمة في حل مشكلة تقابل الجميع وفقكم الله لما يحب ويرضى Last Price SALIM.rar

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

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

تفضل اخي اضغط الزر الذي لديك في الورقه اضافة بيانات جديدة2.rar

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

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

تفضل اضافة بيانات جديدة1.rar

السّلام عليكم و رحمة الله و بركاته بارك الله فيك أستاذنا القدير " الصّقر " على السلسلة الموسوعة القيّمة .. جزاك الله خيرًا و زادها بميزان حسناتك .. لمسات علميّة بسيطة في طرحها فائقة الجودة في محتواها .. زادك الله من علمه و فضله .. ألف تحية تقدير واحترام للأستاذ العزيز المحترم محمد حسن المحمّد .. محاولة طيبّة منك سيّدي الكريم تشكر عليها .. فقط كملاحظة أستاذي الفاضل " الصّقر " بالنسبة لموضوع الكومبوبوكس بسلسلة "علّمني كيف أصطاد" أرجو أن تنّونا بما أنعم الله عليك في هذه الجزئيّة الخاصّة ب :ROWSOURCE قمت بعمل كومبوبوكس لإظهار قائمة اسمية وزر أمر بالشيت 1 .. فكانت النتيجة حسب الصورة الآتية : طيّب .. نقلتُ زر الأمر إلى الشيت 3 فكانت النتيجة بكومبوبوكس فارغة : لو تكرمت أستاذنا القدير فضلاً لا أمرًا أن تكمل لنا الدواء الناقص بهذه الوصفة بكيفية إضافة اسم الشيت بهذا الكود للتمييز بين الشيتات ليكتمل الموضوع بأذهاننا على أكمل وجه : لو كان الأمر من نافذة الخصائص ..فهذا أمر بسيط لأنّ اسم الشيت سيكون مكتوب : فائق احتراماتي

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

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

تسلم حبيبي صلاح المصري كتاب رائع فعلا به اساسيات وهذا ما نريده في جميع الكتب نفعك الله بالعلم والعمل الصالح مع خالص شكري اخوك : ياسر العربي

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

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

السلام عليكم جرب اضافة هذا السطر في البداية Application.ScreenUpdating = False وهذا في النهاية Application.ScreenUpdating = True تحياتي

أستاذن الكبير أ/ ياسر أستاذنا الكبير أ/ ياسر خليل لدى حل بسيط بس أكدي مش بنفس قوة حلك وهو انك تحفظ الملف بصيغة .xlsb والنتيجة أنه بيكون الحجم أصغر بحوالي 50% وأسرع وأخف يارب يكون حل مفيد ومجدي للجميع وفي انتظار حلك المميز واليكم الفرق في المرفقات Last Price SALIM.rar

تفضل مع ملاحظة وضع مرجع ل microsoft office object library وحسب الاصدار لديك If Application.FileDialog(msoFileDialogFilePicker).Show = -1 Then DoCmd.TransferSpreadsheet , , "table1", Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1), True بالتوفيق ولديك الخيار استاذ علي في تنفيذ امر مسح السجلات من الجدول او حذف الجدول قبل تنفيذ الامر السابق تحياتي

وعليكم السلام أختي انا عملت لك 3 استعلامات ، على اساس الحوارات اللي دارت بينك وبين الاستاذ رمهان رجاء تتأكدي من النتائج جعفر 236.‫tajera3.mdb.zip

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

اخى الحبيب اليك الحل book.rar

السلام عليكم أخي الحبيب إبراهيم أبو ليله المحترم: كم كنت أتمنى أن أراجع دراسة هذا الشرح الرائع والمتميز مرات ومرات تعلمنا من حضرتك أن الحلقة التكرارية تغنينا عن كتابة كل خلية حسب موقعها ضمن الكود كما أتمنى أن يكتب الكود يوماً ما بالعربية، ألا يكتب الإنكليز بلغتهم والصينيون بلغتهم والهنود أيضاً فلم لا يكون لنا استقلالنا بكل شيء فنكتب مثلاً - وهو حلم نود لو تحقق ذات يوم: تقبل تحياتي.. Sub enterdata_for1() Dim h As Integer For h = 23 To 26 Cells(h, 8) = h - 22 Next End Sub كود إدخال_بيانات_لأجل1() تعريف h كعدد صحيح لأجل h =23 إلى 26 الخلايا (h,8)=h-22 التالي نهاية الكود

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

والله ليك وحشه يا غالى اتمنى ان تكون بخير وصحه وعافيه وان تكون بيننا فى القريب العاجل

السّلام عليكم و رحمة الله و بركاته فعلاً .. ملف على المقاس .. بارك الله فيك وجزاك الله خيرًا إحتراماتي

اسف على التاخير سوف تجد كثير من الاختصار في الواجهة الرئيسية لانك سوف تلاحظ انها موجودة في نماذج تعديل الطلاب ونماذج تعديل الدورات DawratH.rar

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

حياك الله اخي العزيز لم افهم الامر هل تريد انشاء حقل جديد لتقسيط المبلغ

الأخ الكريم غرب الإكسيل (متخليك شرق عشان تكون معانا) جرب الدالة المعرفة التالية علها تفي بالغرض Function CalcString(S As String) Dim ArrLetters, ArrValues, X() As Byte, SpaceCounter As Long Dim I As Long, Counter As Long, Pos& ArrLetters = Join(Array("أ", "ا", "إ", "ب", "ت", "ث", "ج", "ح", "خ", "د", "ذ", "ر", "ز", "س", "ش", "ص", "ض", "ط", "ظ", "ع", "غ", "ف", "ق", "ك", "ل", "م", "ن", "ه", "ة", "و", "ي")) ArrValues = Array(1, 1, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 26, 27, 28) X = StrConv(S, vbFromUnicode) For I = 0 To UBound(X) Pos = InStr(ArrLetters, Chr(X(I))) If Pos > 0 Then Counter = Counter + ArrValues((Pos - 1) / 2) Next I SpaceCounter = SpaceCount(S) CalcString = Counter - SpaceCounter End Function Function SpaceCount(ByVal strLine As String) As String Dim Str As String Dim TempCount As Long Dim I As Long Str = Trim(strLine) TempCount = 0 For I = 1 To Len(Str) If Mid(Str, I, 1) = " " Then TempCount = TempCount + 1 Else If TempCount > 0 Then SpaceCount = SpaceCount & " " & TempCount TempCount = 0 End If End If Next I SpaceCount = Mid(SpaceCount, 2) End Function وإليك الملف المرفق Sum Letters.rar

السلام عليكم اولا ، اللي اوله شرط ، آخره نور انا ما عندي الاكسس 64 بت ، وما عندي تجربة في الموضوع ، لكني اتذكر ان اختنا الفاضلة الدكتورة أم عهود (حفظها الله اينما كانت) ، كان لها اجابة لهذا الموضوع ، فانا هنا ساعي بريد ، اكتب لكم بالضبط ما كتبته هي في منتدى الفريق العربي للبرمجة ، والشرط هنا ، اني قد لا استطيع مساعدتكم للنهاية ، لأني لا املك اكسس 64 بت والظاهر هنا ، ان الشئ الوحيد الذي يختلف فيه 64 بت عن 32 بت هو في بعض اوامر الكود والوحدات النمطية التي تنادي user32 مثلا ، اي انها 32 بت. والان من هنا ورايح هي مشاركة اختنا الفاضلة زهرة: في حالة وجود اكثر من وحدة نمطية بها Declare فإننا سوف نضع مثل هذا الكود في كل وحده نمطية على حده لتعمل على النظامين 32 بت و 64 بت وطبعا تختلف التصاريح من وحده نمطية والأخرى عن بعضها البعض #If Win64 Then Private Declare PtrSafe Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #Else Private Declare Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #End If دالة تحجيم النموذج بعد التعديل Option Compare Database #If Win64 Then Private Declare PtrSafe Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #Else Private Declare Function DisplaySize Lib "user32" Alias "GetSystemMetrics" (ByVal nIndex As Long) As Long #End If Public Function resizefrom(frm As Form, bestw As Integer, besth As Integer) On Error Resume Next wrate = DisplaySize(0) / bestw hrate = DisplaySize(1) / besth frm.InsideWidth = frm.InsideWidth * wrate frm.InsideHeight = frm.InsideHeight * hrate Dim fc As Control For Each fc In frm.Controls fc.Top = fc.Top * hrate fc.Left = fc.Left * wrate fc.Width = fc.Width * wrate fc.Height = fc.Height * hrate fc.FontSize = fc.FontSize * wrate Next End Function اما الوحدات النمطية التي ليس بها Declare فتبقى كما هي بدون اي تغيير ملاحظة هامة للفهم عند اضافة PtrSafe فإنها تحتاج ايضا الى تعديل بعض المؤشرات Long تتغير الى LongPtr مثال Dim lStructSize As LongPtr دالة ()Len تتغير الى ()LenB حتى يتم قبولها في نظام 64 فقط مثال tsFN.lStructSize = LenB(tsFN) بقية المؤشرات مثل String و Boolean فإنها تبقى كما هي بدون تغيير راجع المصدر https://msdn.microsoft.com/en-us/library/office/gg264421.aspx بالتوفيق

الأستاذة / كفاح السلام عليكم ورحمة الله وبركاته إليك الملف لعله المطلوب. Book222.rar

الكود التالي يقوم بالمعالجة في عمود الاسماء بالتالي لا يحتاج الى عمود اضافي Sub AL_KHALEDI() Set Rn = Range(Cells(2, 2), Cells(Rows.Count, 2).End(xlUp)) Lr = Rn.Rows.Count ReDim Arr(Lr - 1) For Each C In Rn.Cells T1 = "": T2 = "" For r = 1 To Len(C) T1 = Mid(C, r, 1) S = Application.Find(T1, "أبجدهوزحطيكلمنسعفصقرشتثخذضظغ", 1) If Not IsError(S) Then T1 = Mid("أبتثجحخدذرزسشصضطظعغفقكلمنهـوي", S, 1) T2 = T2 & T1 Next r Arr(A) = T2: A = A + 1 Next C Range("B2").Resize(Lr).Value = WorksheetFunction.Transpose(Arr) Range("B2:J2").Resize(Lr).Sort Range("B2"), xlAscending A = 0 For Each C In Rn.Cells T1 = "": T2 = "" For r = 1 To Len(C) T1 = Mid(C, r, 1) S = Application.Find(T1, "أبتثجحخدذرزسشصضطظعغفقكلمنهـوي", 1) If Not IsError(S) Then T1 = Mid("أبجدهوزحطيكلمنسعفصقرشتثخذضظغ", S, 1) T2 = T2 & T1 Next r Arr(A) = T2: A = A + 1 Next C Range("B2").Resize(Lr).Value = WorksheetFunction.Transpose(Arr) Set Rn = Nothing: Erase Arr End Sub

أخي العزيز / عبد الله بلال ضع المعادلة التالية في الخلية (F33) =IF(OR(AND(C10="متزوج";E10=0;M9="ماكثة / بطال");AND(C10="متزوجة";E10=0;M9="ماكثة / بطال"));5.5;IF(OR(AND(C10="متزوج";E10>0;M9="ماكثة / بطال");AND(C10="متزوجة";E10>0;M9="ماكثة / بطال"));800;IF(OR(AND(C10="متزوج";M9="عاملة / عامل");AND(C10="متزوجة";M9="عاملة / عامل");AND(C10="أعزب";C10="عزبة"));0;0))) لكن يجب الإنتباه لتسمية القوائم في الخلايا المحددة للشروط لأنها لم تظهر لإرتباطها بنطاقات غير موجودة في الملف المرفق خاصة الخلية (C10) والخلية (M9) فعلى سبيل المثال في الخلية (M9) التي تحدد وضعية الزوج والزوجة جعلتها مشتركة (ماكنة/بطال) كذلك جعلتهاأنا في الشرط الثاني (عاملة/عامل) أرجو الإنتباه لذلك والتعديل على ما هو مكتوب عندك بالضبط حتى تكون النتائج مضبوطة واإن شاء الله يكون هو المطلوب وإذا في أي خطأ ممكن الإشار إليه لتصحيحه والعفو كشف.rar

إضافة بسيطة على كلام أخي ابو اسامة يتم وضع الكود السابق في حدث عند تغير التحديد في ورقة العمل فيصبح الكود Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.HasFormula Then Application.DisplayFormulaBar = False ActiveSheet.Protect Else Application.DisplayFormulaBar = True ActiveSheet.Unprotect End If End Sub وكل عام أنتم بخير بمناسبة شهر رمضان الكريم أخوكم محمد صالح