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

السلام عليكم البحث عن اخر سعر بناء على شروط كاسم الصنف او المنتج والعميل تم استخدام الدوال التالية: INDEX , IF , ROW , MAX , MATCH لاتنسونا بصالح دعاؤكم هذا الموضوع كان سؤال لاحد الاعضاء . قد شارك فى حله اساتذة المنتدى وقد كان هذا حلى الذى احببت ان اعرضه فى موضوع منفصل وبشكل تفصيلى ={INDEX(E3:E14;MATCH(MAX(IF((D3:D14=H2)*(C3:C14=H3);ROW(C3:C14);""));ROW(C3:C14);0))} اخر سعر للصنف بالنسبه للمنتج للعميل.rar

السلام عليكم هذا الكود يمكن ان أسميه فخ أو لغم من المعلوم أن هناك برامج لفك حماية الشيتات لا نستطيع مقاومتها أومنعها من كسر الحماية والمستخدم يقوم بكسر حماية الشيت للحصول على المعلومات السرية داخل البرنامج (معادلات ـ أعمدة مخفية .....الخ) إذا منعنا المستخدم من الحصول على هذه المعلومات السرية فنكون قد حققنا الهدف يبدأ عمل الكود من حدث الصفحة SELLECTION CHANGE ثم ينتقل إلى الإجراء booom وهو يقوم بحذف أوراق محددة عندما يتم فك حماية الورقة (الشيت) والنقر على أي خليه فيها ولكن انتبه : فيمكن أن يكون المبرمج نفسه هو ضحية لهذا الكود (كما حصل لي شخصيا أثناء العمل على هذا المرفق) إذا عاود المبرمج فك حماية الصفحة لتعديل أي معادلة مثلا وتحديد أي خلية سينفجر اللغم وتحذف الأوراق تلقائيا ويقفل البرنامج لذا بعد الانتهاء من عمل أي برنامج وبعد حماية الصفحات يتم وضع هذا الكود فإذا اراد المبرمج في وقت لاحق فك الحماية على الصفحة للتعديل عليها فيجب قبل ذلك الذهاب لمحرر الفيجوال والدخول على الماكرو booom وتعليق السطر الآتي ' Sheets(Array(1, 3, 4)).Delete لأنه المسؤول عن حذف الأوراق (الأولى والثالثة والرابعة) تفضلوا المرفق والشرح داخل الكود abo eed file.rar

جرب =IF((C17>=5),0,C20-(C17*20))

السلام عليكم ورحمة الله تعالى وبركاته بفضل الله تعالى تم انجاز المشروع والحمد لله وذلك لطلب الاخوة فى هذا الموضوع http://www.officena.net/ib/index.php?showtopic=62339&hl= الموضوع يتلخص فى نظام مراسلة وارسال رسالة بين المستخدمين لقاعدة البيانات شبيه بالفيس بوك صفحة تسجيل الدخول قمت باضافة شى مهم جدا وهو ربط نموذج باستضافة مجانيه به جدول وضعته اذا احببت ارسال تعليق لى بخصوص البرنامج شكر الله لكم جميعا والاكواد الخاصة بهذا الربط مدرجة فى هذا الموضوع http://www.officena.net/ib/index.php?showtopic=61514 الصفحة الشخصية بها قائمة الاصدقاء ونظام المراسلة منصة عرض الرسائل والارشفة قوائم الاعضاء ويمكنك اضافة الاصدقاء الى قائمة اصدقائك والان مع البرنامج تحياتى

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

هام جدا للمحاسبين والمديرين الماليين تحديد نقطة التعادل في حالة تعدد المنتجات ************************************************* تخطط شركة شارب لإنتاج ثلاثة أنواع من التكييفات فماهي مبيعات التعادل التي ينبغي على الشركة تحقيقها بفرض ان التكاليف الثابتة 95000 جنية تم استخدام تقرير مدير السيناريو تحديد-التعادل-فى-حالة-تعدد-المنتجات(1).rar

السلام عليكم ورحمة الله وبركاته استخدام الداله max , min بشرط لاتنسونا بصالح دعاؤكم دوال MAX ,MIN المقرونه بشروط.rar

شكرا جزيلا أخي محمد على هذا الإطراء الجميل :-) وعندي ملاحظة على لوحتك لي ، أنه لا دخل لمسقط بالبحرين :-) جعفر

جزاك االه خيرا وجارى التجربة

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

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

اخى الكريم جرب المرفق علة المطلوب نموذج.rar

تفضل أخي الفاضل أبو نبأ الملف التالي ..جرب الملف ووافنا بالنتائج Client Account Report YasserKhalil V3.rar

استبدل اسم الورقة فى الكود ( ورقة 13 ) بتلك الكلمة ActiveSheet وابدى ملاحظاتك

جزاكم الله حيرا

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

هل رقم الوصل المقصود به رقم الفاتورة .. جرب الملف التالي تم الاعتماد على رقم العميل ورقم الفاتورة واسم العميل كشرط لتصفية الحساب أي أنه كما في المرفق لن يتم إلا تصفية صف واحد من الثلاثة صفوف لأن أرقام الفواتير مختلفة Client Account Report YasserKhalil V2.rar

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

السلام عليكم ورحمة الله وبركاته الموقع يعمل بشكل جميل على الهاتف المتحرك ، و لكن هناك بعض الملاحظات عند استعماله بالهاتف المتحرك: المواضيع تكون بعرض الهاتف ، ولكن: 1. هناك banner دعايات في اعلى الصفحة و آخر في نهاية الصفحة ، و هما أعرض من الصفحة ، مما يجعل الصفحة نصف فارغة من اليسار ، 2. بالإضافة إلى banner اوفسينا الأول من اليسار ، والذي كذلك خارج عرض الصفحة ، 3. عند الكتابة ، و عند الضغط على الزر Enter ، فينتقل الـ cursor إلى السطر التالي ، ولكن الصفحة لا تظل ثابته ، بل تزحف إلى اليسار أو إلى الأعلى ، مما يتطلب تضبيط الصفحة يدويا لمكان الكتابة مرة أخرى ، 4. عند كتابة جملة ثم تريد أن تضيف حرف إلى احد الكلمات السابقة ، فالحرف الجديد لا يكون مشبوك مع الكلمة. 5. عند كتابة كلمة ، وأردت مسحها باستخدام زر back space ، فالـ cursor لا يمسح من نهاية الكلمة ، و إنما يعدي الحرف الأخير ويمسح ما قبله ، 6. عند اختيار الوجوه ، النافذة الجديدة كذلك أعرض من صفحة المنتدى ، ولكن لا يمكن زحف الصفحة يدويا ، عمل مبارك إن شاء الله ، وعلى بركة الله جعفر

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

لا استطيع ان اعبر عن سعادتى بنا يوفقكم يا الله على هذا النبوغ والعبقرية شكرا من اعماق قلبى الف شكر

أخي الكريم إليك الكود التالي بعد التعديل في الكود الموجود ليناسب طلبك Sub FindAllBills() Dim WS As Worksheet, SH As Worksheet Dim Arr, I As Long Set WS = Sheets("فاتورة"): Set SH = Sheets("استدعاء فاتورة") With Application .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False End With If IsEmpty(SH.Range("A3")) Then MsgBox "أدخل كود العميل المطلوب استدعاء فواتيره", 64: Exit Sub SH.Range("A4:N100000").Clear Arr = Split(FindRange(SH.Range("A3"), WS.Columns("C:C")), ",") For I = LBound(Arr) To UBound(Arr) On Error Resume Next If Month(WS.Range(Arr(I)).Offset(-3, -1)) = SH.Range("C3").Value Then WS.Range(Arr(I)).CurrentRegion.Copy SH.Range("A" & SH.Cells(Rows.Count, 1).End(3).Row + 2) ElseIf IsEmpty(SH.Range("C3").Value) Then WS.Range(Arr(I)).CurrentRegion.Copy SH.Range("A" & SH.Cells(Rows.Count, 1).End(3).Row + 2) End If Next I With Application .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True End With End Sub Function FindRange(FirstRange As Range, ListRange As Range) As String Dim aCell As Range, bCell As Range, oRange As Range Set oRange = ListRange.Find(what:=FirstRange.Value, LookIn:=xlValues, Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) If Not oRange Is Nothing Then Set bCell = oRange: Set aCell = oRange Do Set oRange = ListRange.Find(what:=FirstRange.Value, After:=oRange, LookIn:=xlValues, Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) If Not oRange Is Nothing Then If oRange.Address = bCell.Address Then Exit Do Set aCell = Union(aCell, oRange) Else Exit Do End If Loop FindRange = aCell.Address Else FindRange = "Not Found" End If End Function

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

بسم الله ما شاء الله تبارك الله روعة أخي الحبيب أبو عيد .. والله وحشتني هداياك .. ممكن إضافة بسيطة جداً .. بدل أن تضع كود في حدث كل ورقة عمل يمكن وضع كود واحد فقط بجانب كود الموديول بالطبع الكود يوضع في حدث المصنف ويتم حذف الأكواد الأخرى في أوراق العمل جميعها Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) On Error GoTo 1 'إذا كانت الصفحة محمية سيظهر خطأ في هذا الإجراء وعند ظهور الخطأ اذهب للرقم 1 بمعنى أنهاء العملية Range("XFD1") = "x" ' وضع إكس في الخلية لإحداث تغيير يتناسب مع حدث الصفحة If Intersect(Target, Range("XFD1")) Is Nothing Then ' إذا حصل التغيير في الخلية المحددة (وبدون أن أحددها) نفذ ما يأتي Call booom 'شغل هذا الماكرو من الموديول End If 1: End Sub تقبل وافر تقديري واحترامي

في الخلية Q7 ضع المعادلة التالية =INDEX($I$12:$I$16,MATCH(S7,$J$12:$J$16,0)) إذا واجهتك مشكلة استبدل الفاصلة الموجودة في المعادلة بفاصلة منقوطة ثم قم بسحب المعادلة

جرب المرفق علة المطلوب كشف حساب جديد_3.rar

أخي الكريم يرجى دائماً بدل الرفع أن توضح بأسلوب آخر فقد يكون المطلوب مبهم أو يحتاج إلى مثال تطبيقي ..عموماً إليك الكود التالي في حدث الورقة حسب ما فهمت ... Private Sub Worksheet_Change(ByVal Target As Range) Dim Cell As Range If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Row > 2 And Target.Column = 10 Then For Each Cell In Range("J1:Q1") If Cell.Value = Target.Value Then Cell.NumberFormat = ";;;" Next Cell End If If Target.Row > 2 And Target.Column = 15 Then For Each Cell In Range("J1:Q1") If Cell.Value = Target.Offset(, -5).Value Then Cell.NumberFormat = "General" Next Cell End If End Sub كود آخر يفي بالغرض بدون استخدام الحلقات التكرارية Private Sub Worksheet_Change(ByVal Target As Range) Dim Found As Range If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Row > 2 And Target.Column = 10 Then Set Found = Range("J1:Q1").Find(What:=Target.Value, LookAt:=xlWhole) If Not Found Is Nothing Then Found.NumberFormat = ";;;" End If If Target.Row > 2 And Target.Column = 15 Then Set Found = Range("J1:Q1").Find(What:=Target.Offset(, -5).Value, LookAt:=xlWhole) If Not Found Is Nothing Then Found.NumberFormat = "General" End If End Sub Custom-Format-Worksheet-Change.rar

انظر إن كان ما في المرفق هو المطلوب... Evaluation Form.rar

أخي محمد الريفي وأخي الصقر حسام المحترمين: معكما حق في ما قلتماه ولكنني كنت أوثر أن لا أبوح به والأخ الصقر استشف من كلامي في مشاركات سابقة ، وانظر إلى دراسة (دراسة سند صرف) قدمتها على قلة علمي لكنني أحسست بالجفاء فكانت المشاركات تأتي على استحياء ، وكنت قد أصريت على كتابتها والمضي بها حتى ولو لم يراها أحد . وهل أتملق الناس ليروا ما كتبته ...كان الأفضل بالنسبة لي أن يروها وينتقدوها وليسفهوها وليضربوا بها عرض الحائط خير لي من هجرها ..لم أسئ لأحد بل كنت إن قسوت في رد اعتذرت عنه قبله وبعده ولكن كنت أقول ما قلة معذرة إلى ربكم. قدمت الدراسة ما النتيجة ؟! لا أخذ ولا رد ولا صرف ولا عد...كلام هذر مذر....لا معنى له سطرته على صفحات كثر...يا للأسف؟؟؟؟؟؟؟؟؟؟؟؟؟!!!!. ليتني تلوت صفحات من القرءان الكريم تقربت به إلى ربي خير من كلام .....(يكلم ويرد على ذاته). أما من حيث الخط فقد رأينا ما اتفق عليه بالتوجيهات (حجم الخط 22 - غامق - وأفضل Times New Roman ولون مناسب كما ذوقكم الرفيع أخوتي الكرام. والصلاة والسلام على سيد المرسلين والحمد لله رب العالمين.

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

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله أقدم لكم اليوم كيفية فتح مستند نصي (مستند ورد) عن طريق فتح تطبيق الورد من داخل الإكسيل .. في الملف المرفق يوجد ملف إكسيل وملف ورد لعمل اختبار عليه .. قم بفك الضغط عن الملف المرفق على سطح المكتب مثلاً عند الضغط على زر الأمر في ورقة العمل ، سيقوم الكود بفتح صندوق حواري (مستعرض الملفات) لتقوم بتحديد مكان أو موقع المستند الذي تريد فتحه .. قم بالذهاب إلى مسار المستند وقم بتحديده ثم اضغط Open لفتح الملف .. إذا لم يتم اختيار ملف ستظهر رسالة تفيد بذلك .. يوجد أيضاً دالة معرفة داخل الموديول تقوم بفحص ما إذا كان الملف مفتوح أم لا ، فإذا كان الملف مفتوح مسبقاً يتم الخروج من الإجراء الفرعي .. إذا أردت التخلص من الدالة وتقليل حجم الكود قم بمسح الدالة Function (الجزء الثاني في الموديول) كما قم بمسح هذا السطر من الكود If IsFileOpen(Sheet1.Range("A1").Value) Then Exit Sub هذا السطر تمت إضافته لفحص الملف إذا ما كان مفتوح أم لا ..لأنه في حالة إذا كان الملف مفتوح مسبقاً وقمت بفتحه مرة أخرى ، سيتسبب ذلك في بطء عمل الكود ، وينتهي برسالة خطأ .. شكل الكود المسئول عن فتح المستند ببرنامج الورد Sub Browse() 'تعريف المتغيرات '---------------- 'تعريف المتغير الذي سيأخذ قيمة مستعرض الملفات Dim strFileToOpen 'تعريف المتغير الذي يشير إلى إنشاء كائن تطبيق الورد Dim objWord 'تعريف المتغير الذي يشير إلى المستند النصي Dim objDoc 'نافذة المستعرض '-------------- 'تعيين قيمة المتغير ليساوي قيمة نافذة مستعرض الملفات ، والذي يمثل مسار المستند الذي يتم اختياره strFileToOpen = Application.GetOpenFilename(Title:="Please Choose A File To Open", FileFilter:="Word Files *.doc* (*.doc*),") 'اختبار اختيار المستند '--------------------- 'إذا لم يتم اختيار مستند يتم إظهار رسالة تنبيه ثم الخروج من الإجراء الفرعي If strFileToOpen = False Then MsgBox "لم يتم اختيار ملف", vbExclamation, "تنبيه" Exit Sub 'إذا كان المستند مفتوح يتم الخروج من الإجراء الفرعي Else 'تساوي قيمة نافذة مستعرض الملفات [A1]الخلية 'يتم وضع مسار المستند بالكامل في الخلية Sheet1.Range("A1").Value = strFileToOpen 'إذا كان المستند مفتوح مسبقاً يتم الخروج من الإجراء الفرعي If IsFileOpen(Sheet1.Range("A1").Value) Then Exit Sub 'تعيين قيمة المتغير ليساوي تطبيق الورد Set objWord = CreateObject("Word.Application") 'تعيين قيمة المتغير ليساوي المستند الذي سيتم فتحه بتطبيق الورد Set objDoc = objWord.Documents.Open(strFileToOpen) 'إظهار تطبيق الورد objWord.Visible = True End If End Sub والدالة المسئولة عن عملية فحص الملف ما إذا كان مفتوح أم لا Function IsFileOpen(filename As String) '[False]أو إلى[True]هذه الدالة تقوم باختبار إذا ما كان الملف مفتوح مسبقاً وترجع القيمة إما إلى Dim filenum As Integer, errnum As Integer On Error Resume Next 'هذا السطر لتجنب رسائل الخطأ filenum = FreeFile() 'الحصول على رقم للملف 'محاولة فتح الملف ثم إغلاقه Open filename For Input Lock Read As #filenum Close filenum 'إغلاق الملف errnum = Err 'حفظ رقم الخطأ الذي يحدث On Error GoTo 0 'استعادة خاصية رسائل الخطأ 'فحص رقم الخطأ Select Case errnum 'في حالة عدم وجود خطأ ، إذاً الملف غير مفتوح Case 0 IsFileOpen = False 'الرقم 70 يعني أن الملف مفتوح وغير مصرح بالدخول عليه Case 70 IsFileOpen = True 'في حالة حدوث خطأ آخر Case Else Error errnum End Select End Function أترككم مع الملف .. ويوجد شرح لأسطر الكود دمتم في عز الله وطاعته Open Word Document.rar

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

اخى الفاضل لابد من حفظ الملف بصيغة XLSM او XLSB لحفظ الاكواد باصدار 2010 تحياتي

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

بالاضافة الى ذلك قف على الخلية المستهدفة ثم رايت كليك - تنسيق خلايا - محاذاة - علم على التفاف النص