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

السلام عليكم اسعد الله صباحكم معادلات متقنة جداااا , زادكم الله علما و نفع بكم زيادة في الخير هذا كود Sub dahmour() Dim L Application.ScreenUpdating = False L = Sheets("ناجح").Range("b" & Rows.Count).End(xlUp).Row Sheets("الاوائل").Range("eb14:ec" & L) = Sheets("ناجح").Range("b14:c" & L).Value Sheets("الاوائل").Range("ed14:ed" & L) = Sheets("ناجح").Range("e14:e" & L).Value Sheets("الاوائل").Range("ee14:ee" & L) = Sheets("ناجح").Range("bp14:bp" & L).Value Sheets("الاوائل").Range("eb14:ee" & L).Sort key1:=[ee14], order1:=xlDescending, key2:=[ed14], order2:=xlAscending Sheets("الاوائل").Range("f11:i20") = Sheets("الاوائل").Range("eb14:ee23").Value Sheets("الاوائل").Range("eb14:ee" & L).Clear Application.ScreenUpdating = True End Sub تحياتي

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

بسم الله الرحمن الرحيم استاذي الفاضل / م. ياسر،،، الاخوة الاعزاء في المنتدى،،، السلام عليكم ورحمة الله وبركاته،،، ارفق الى سيادتكم بعد اذن استاذنا ياسر ملف معدل وتم تحويل اللغة من التايلندية الى الانجليزية - ( قد يكون بها اخطاء في الترجمة - لكنها قد توفي المطلوب وتوصل المعلومة للمتدرب " ترجمة جوجل" ) نفع الله بهذه المعلومات وجعلها في موازين حسناتنا والاستاذ / ياسر ووالدينا وكل من كان همه نفع الناس. وصل اللهم وسلم على سيد الخلق اجمعين والحمد لله رب العالمين Advance Excel Function Training(Ed).rar

الغاء ازرار النسخ واللصق في لوحة المفاتيح Ctrl+C , Ctrl+V Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) If (Shift And 2) And (KeyCode = Asc("C")) Then KeyCode = 0 MsgBox "No Coping Allowed, Cheater!!!" ElseIf (Shift And 2) And (KeyCode = Asc("V")) Then KeyCode = 0 MsgBox "No Pasting Allowed, Cheater!!!" End If End Sub

تم التعديل على الملف بحيث يقوم بعماية البحث في 3 احتمالات الاسم فقط الاسم و الرقم الرقم فقط القائمة المنسدلة مطاطة تستجيب لاي تغيرات في الاسماء شرط ان لا يتكرر الاسم آمل ان ينال اعجابكم اضغط افضل اجابة و خلاص بقى ترحيل البيانات المكررة عند البحث salim avancee.zip

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

أخي الفاضل أبو نبأ إليك الكود التالي عله يكون المطلوب .. حاولت الابتعاد عن استخدام الحلقات التكرارية حتى يعمل الكود بكفاءة مع البيانات الكثيرة اعتمدت في التفكير على استخدام الفلترة ... أي كل رقم كود أقوم بفلترته ثم نسخ البيانات المرتبطة بعملية الفلترة إلى آخر ورقة عمل أرجو أن يكون المطلوب Sub TransferDataBasedOnCode() Dim wsMain As Worksheet, wsBranch As Worksheet, SH As Worksheet Dim rngData As Range, Rng As Range, Cell As Range, LR As Long Set wsMain = Sheets("الرئيسية"): Set wsBranch = Sheets("الفرعية"): Set SH = Sheets("الكود الموجود") LR = IIf(wsBranch.Cells(Rows.Count, 1).End(xlUp).Row = 1, 2, wsBranch.Cells(Rows.Count, 1).End(xlUp).Row) Set Rng = wsBranch.Range("A2:A" & LR) Set rngData = wsMain.Range("A1:K" & wsMain.Cells(Rows.Count, 1).End(xlUp).Row) Application.ScreenUpdating = False If Application.WorksheetFunction.CountA(Rng) < 1 Then MsgBox "لا يوجد أرقام كود لترحيلها", vbInformation: Exit Sub For Each Cell In Rng With wsMain .AutoFilterMode = False .Range("A1:K1").AutoFilter Field:=2, Criteria1:=Cell.Value If rngData.Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then GoTo Skipper rngData.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy SH.Range("A" & SH.Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial xlPasteValues End With Skipper: Next Cell wsMain.AutoFilterMode = False SH.Range("A1").Select Application.CutCopyMode = False Application.ScreenUpdating = True End Sub لا تنسى أن تحدد أفضل إجابة ولو فيها تعب ليك اضغط على "أعجبني هذا" إذا أعجبك الحل تقبل تحياتي :fff: Transfer Data Based On Code.rar

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

السلام عليكم ورحمة الله وبركاته: أخي عبد العزيز المحترم..جزاكم الله خيراً..إلا أنني أتصور وأكاد أجزم أنه لا يمكن أن تكون هناك مطابقة تامة بين التاريخين الميلادي والهجري ولو كان هنالك لما احتاج مطوري برامج ويندوز وضع زائد أو ناقص يومين وكذلك جوالات أندرويد وغيرها ولما احتاج المسلمون لمراقبة هلال الأشهر القمرية وخصوصاً هلال شهر رمضان وشوّال وذي الحجة والمحرّم...هذا رأيي وقناعتي. فإن كان هناك ما يدحض هذا القول إيتوني به وأكون لكم من الشاكرين. تقبلوا تحياتي والسلام عليكم ورحمة الله وبركاته.. السلام عليكم و رحمة الله و بركاته سيّدي الفاضل محمد حسن المحمد ..ما قلتَه هو الحقيقة بذاتها و صفاتها .....خلاصة الخلاصة هي أنّه لو كان هناك تطابق مضبوط لاكتفينا في صيامنا و أعيادنا و جميع شعائرنا الدينية و الدنيوية بالرزنامة الميلادية .. فائق احتراماتي سيدي الكريم السلام عليكم ورحمة الله وبركاته:شهادة حق وإنصاف من أخ ٍ كريم لأن التاريخ الهجري هو التاريخ الحقيقي لأنه لم يخضع لحسابات البشر رغم اجتهادهم ولكنهم اخترعوا الميكروسكوبات لمراقبة حركة القمر وبالرغم من تحوّله وانتقاله عبر فصول السنة لا يزال فوق حساباتهم أما الميلادي خضع لحسابات البشر فأقاموا وعدلوا وزادوا وأنقصوا 365.25 يوماً جعلوا شباط 28 يوماً وبعضها 30 والآخر 31 أما الهجري فالشهر قد يأتي مرة 30 يوماً وأخرى 29 إلا أنني لم أسمع بشهر هجري28 يوماً. ولكن قل لي أي شهر منها تحكموا بعدد أيامه فجعلو..تقبلوا تحياتي...السلام عليكم ورحمة الله وبركاته.

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

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

أخي الكريم أبو سما بافتراض أن البنود ثابتة بنفس الترتيب في ورقتي العمل إليك الكود التالي عله يفي بالغرض Sub SUMTwoSheets() Dim WS As Worksheet, SH As Worksheet Set WS = Sheets("المخزن"): Set SH = Sheets("إذن صرف") Application.ScreenUpdating = False Application.DisplayAlerts = False If MsgBox("سيتم جمع القيم في ورقتي العمل في العمود الخامس" & vbNewLine & "هل أنت متأكد من الاستمرار؟", vbYesNo) = vbNo Then Exit Sub Sheets.Add After:=Sheets(Sheets.Count) With ActiveSheet SH.Range("C8:C55").Copy .Range("A1") SH.Range("G8:G55").Copy .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1) WS.Range("E4:E" & WS.Cells(Rows.Count, 2).End(xlUp).Row).Copy .Range("B1") With .Range("C1:C" & .Cells(Rows.Count, 1).End(xlUp).Row) .Formula = "=IF(AND(A1="""",B1=""""),"""",SUM(A1:B1))": .Value = .Value .Copy: WS.Range("E4").PasteSpecial xlPasteValues End With .Delete End With WS.Activate Application.CutCopyMode = False Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub لا تنسى أن تحدد أفضل إجابة ليظهر الموضوع مجاب ومنتهي تقبل تحياتي SUM Two Sheets.rar

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

قم بالإطلاع على المرفق التالي لتتضح الفكرة لك وإذا أعجبتك الفكرة بدأنا في التنفيذ Store V1.rar

من منا من لم تحدث له هذه المشكلة وهي تعليق قاعد البيانات في الذاكرة فلا تفتح ولا تقفل مما يضطر البعض إلى إعادة تشغيل الجهاز إليكم هذه الطريقة البسيطة لتجاوز هذه المشكلة 1- اضغط على ctrl+Alt+Delet فيظهر أمامك إطار إدارة المهام افتح على تبويب التطبيقات كما في الصورة اليمنى ثم أشر عل قاعدة بياناتك فستلاحظ أن زر إنها المهمة أصبح فعالا فانقر عليه لإنهاء تشغيل القاعدة . 2- إذا لم تجد قاعدة بياناتك في هذا التبويب فافتح تبويب العمليات كما في الصورة اليسرى ولاحظ الاسم الذي تم التأشير عليه فهذا الاسم خاص بقواعد بيانات أكسس أشر عليه ثم اضغط انهاء العملية في الأسفل . مسألة صغيرة أرجو أن يكون نفعها أكبر ،،،

بعد الوصول لمستند تحليل النظام ( النسخة الثانية ) سنبدأ هنا فى تحويل التحليل الي رسم ال ERD ثم الي تصميم جداول فى االأكسس و الشرح و المثال فى الملف المرفق ( ملف وورد + ملف أكسس ) و المطلوب هو مراجعة المثال و الشرح و وضع الاضافات و التعديلات التي ترونها حلقة الحوار الخاصة بالموضوع ملاحظة : انتهت فترة الحوار و تم اغلاق الحلقة مع تحياتي ERD_TableDes.zip

السلام عليكم و رحمة الله و بركاته اخواني و اساتذتي رواد منتدانا الغالي كل عام و انتم و الامه الاسلاميه بخير و صحة و عافيه و عيدكم مبارك هديتي متواضعه كعلمي و ارجو من الله ان يكون بها فائدة لاخواني المبتدئين على وجه الخصوص برنامج المعاملات : يقوم بحفظ بيانات المعاملات و من ثم يتم تصنيف المعاملات الى 6 فئات 1: منجزة تحت الاجراء : لم تتجاوز الثلاثة ايام و ينطبق على الفئة الرابعة 2: منجزة متأخرة : ما بين 4 الى 10 ايام و ينطبق على الفئة الخامسة 3: منجزة متأخرة جداً : اكثر من 10 ايام و ينطيق على الفئة السادسة 4: غير منجزة تحت الاجراء : 5: غير منجزة متأخرة 6: غير منجزة متأخرة جداً - تدوين كامل بيانات المعاملة واضافة اكثر من مرفق للمعاملة الواحدة و تصفح المرفقات ( يتم فك الضغط عن الملف بالدرايف C و حفظ جميع صور المعاملات المراد استعراضها من البرنامج بالملف Photos و يمكن تغيير المسار بالدخول على الكود ) علماً بأن الصور فقط بالامتداد JPEG - هناك عملية متابعه يتم من خلالها عرض المعاملات الغير منجزة و عرض تقرير بها - تقرير يشتمل على رسوم بيانيه للاحصاء و المقارنة يوضح النسبة المئويه لعدد المعاملات المنجزة لجهة او اربعة جهات كحد اقصى كما يوجد احصاء لجميع المعاملات المنجزة و الغير منجزة ( تقريرين حسب نوع المقارنة ) - ارسال بريد الكتروني لجميع المعاملات التي لم تنجز في اكثر من 3 ايام و تدوين تاريخ و وقت ارسال الايميل تلقائي - التحكم في نص الرسالة و و عنوانها و الجهة المراد ارسال نسخة من البريد اليها - صلاحيات للمستخدمين تتكون من مستويين : 1: كامل الصلاحيات : و بتحديدها يتم الدخول على كامل البرنامج 2: صلاحية محدودة : وفيها فقط يتم استعراض السجلات و عمل الاحصائيات و المقارنات 3: تحديد كامل الصلاحية او الصلاحية المحدودة يتم من خلال مربع اختيار CheckBox 4: شاشة لمتابعة دخول و خروج المستخدمين ليتابعها المسئول مع ملاحظة بأن سجلات هذا الجدول ستكون في ازدياد بعدد مرات الدخول الى البرنامج و ينصح بشدة التخلص منها و حذفها في حالة عدم الحاجة اليها . البرنامج مفتوح و بدون الشفت او اخفاء الاكسس ايضاً ليتمكن اخواني المبتدئين من الاستفادة من الاكواد الموجودة فيه اسأل الله عز و جل التوفيق للجميع اخوكم : يوسف Documentation.rar

ترقيم تلقائي يتجدد مع بداية كل سنة على النحو التالي 1300001 1300002 1300003 1400001 1400002 وهكذا ................. باعتبار الرقم 13 ، 14 هو السنة والترقيم لاشك سيكون تبعا للسنة الحالية Private Sub Form_BeforeInsert(Cancel As Integer) On Error Resume Next Dim xLast, xNext As Integer Dim prtyr, prtTxt As Integer prtyr = Right(DatePart("yyyy", Date), 2) prtTxt = Left(DMax("ID", "tbl1"), 2) xLast = DMax("ID", "tbl1", prtTxt = prtyr) If IsNull(xLast) Then xNext = 1 Else xNext = Val(Mid(xLast, 3, 5)) + 1 End If Me!ID = prtyr & Format(xNext, "00000") End Sub ترقيم تلقائي جديد كل سنة.rar

فيه طريقة سهلة ومرنة افتح النموذج الفرعي لوحده add_assist ومن شريط الادوات ومن النافذة الرئيسية اختر ايقونة الاجماليات . سيظهر سطر جديد به خيارات حسابية اختر المجموع مثلا سيتم جمع كل عمود رقمي ! اغلق النموذج ثم افتح النموذج الاساسي add_invioce سترى النموذج الفرعي وبه سطر الاجمالي ! بالتوفيق

اكتب هذه المعادلة في الخلية I5 واسحب يساراً =COUNTIF($G$2:$G$519,TRIM(I$2))

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

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

لمزيد من التفاصيل حول كيفية التعامل مع المنتدى يرجى زيارة ها الرابط من هنا

السلام عليكم ورحمة الله ونعم الأخ العزيز ألا ترى أن اسم أحمد عوض خير من ذلك الذي لم أستطع فهمه لكنت كتبت اسمي mhmdhsnsyr تقبل تحياتي ..ولكن ما زلت راغباً بظهور اسم أحمد على اسم خير الخلق وحبيب الحق ..فما قولك؟؟؟!. على خير كما تريد نغير للاسم الحقيقى

السلام عليكم الاخ الكريم خلبد الرشيدى نرجو شرح المعادله وجزاك الله كل الخير

وهذا حل آخر عند انتهاء اليوم ترجع الخلية بنفس اللون السابق بمعنى يلون في نفس التاريخ فقط OVER 14 DAYS_2.rar

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

أخي الحبيب / محمد الخازمي عذرا لم أر مشاركتك

السلام عليكم تقضل تاريخ.rar

في ميزان حسناتك ان شاء الله

ملاحظة : يوجد معادلة مميزة جدا لاستاذنا الخالدي علي هذا الرابط , المطلوب مختلف قليلا لكن المعادلة تستحق الذكر (ترتيب اكثر من شرط بنفس المعادلة) http://www.officena.net/ib/index.php?showtopic=46663#entry279751 تحياتي

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

السلام عليكم ورحمة الله وبركاته إخوتي الأكارم : لماذا نحن نقرأ الأسماء التي علمنا إياها من هم أقدم منا ...فمثلاً رياضيات ...طب ...إلخ ...؟. تعالوا نقترح للزوايا الدائرية اسماً جديداً ...نطلق عليها اسم :(رياضيات ما بعد الحديثة) أقول هذا على سبيل الدعابة ..وأعتذر لأخي أبو لجين المحترم..فالجفاف يسبب أخاديد في الوجه كما كثرة الضحك سواء بسواء. ولكم في رسول الله أسوة حسنة..مازح عجوزاً بقوله صلى الله عليه وآله وسلم:(لا تدخل الجنة عجوز!.) والسلام عليكم ورحمة الله وبركاته.

كود فى منتهى الروعة بارك الله فيك

أخي الحبيب علاء جرب معادلة الصفيف التالية في الخلية A4 للتعامل مع الشرطين =IF(ROWS(A$4:A4)<=SUMPRODUCT((البيانات!$F$2:$F$100=$B$1)*(البيانات!$C$2:$C$100=$B$2)),INDEX(البيانات!A$2:A$100,SMALL(IF((البيانات!$F$2:$F$100=$B$1)*(البيانات!$C$2:$C$100=$B$2),ROW(البيانات!A$2:A$100)-ROW(البيانات!$A$2)+1),ROWS(A$4:A4))),"") تقبل تحياتي

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

أخي الكريم خالد هلال إليك الملف التالي عله يفي بالغرض Sub Tarhil() Dim WS As Worksheet, SH As Worksheet Dim LR As Long Set WS = Sheets("الإيصال"): Set SH = Sheets("اليومية") LR = SH.Cells(Rows.Count, 6).End(xlUp).Row + 1 Application.ScreenUpdating = False With SH .Range("A" & LR) = LR - 4 .Range("B" & LR) = WS.Range("G3") .Range("C" & LR) = WS.Range("G2") .Range("D" & LR) = WS.Range("B4") .Range("E" & LR) = WS.Range("B5") .Range("F" & LR) = (WS.Range("B6") - Int(WS.Range("B6"))) * 100 .Range("G" & LR) = Int(WS.Range("B6")) .Range("H" & LR) = WS.Range("D5") .Range("I" & LR) = WS.Range("B7") WS.Range("G3") = WS.Range("G3") + 1 End With MsgBox "تم الترحيل بنجاح", vbInformation Application.ScreenUpdating = True End Sub لا تنسى أن تحدد أفضل إجابة ليظهر الموضوع مجاب ومنتهي كما لا تنسى أن تضغط أعجبني هذا إذا أعجبتك المشاركة وأدت الغرض تقبل تحياتي Tarhil YasserKhalil.rar

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

تفضل أ.أيمن المطلوب بالمرفق المصنف1.rar

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

تفضل هذا برنامج لأحد الاخوة الفضلا آمل ان يلبي حاجتك لا تنسى صاحبه من دعوة صالحة فواتير مبيعات.rar

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

ألف ألف مبروك على الترقية المستحقة أ / سليم مع مزيد من التقدم والإزدهار

اليك هذا الملف يمكنك اختايار المرتبة التي تريد و تبديل الاسماء التي تناسب العاشرة /الرابعة /الاولى حسب الختيار من الخلية J1 اضغط افضل اجابة اذا كان كذلك أعلى نتيجة اختيارية.zip

السلام عليكم تفضل المطلوب قائمة منسدلة من قائمة منسدله اخرى.rar

وهذه طريقة أخرى عبر الدالة والاستعلام (للإستزادة) تحسب حسب العام والشهر واليوم في نموذج QryDate _ارشيف المهام.rar

هذا هو الكود المسؤول Option Compare Database Dim Stest As Byte Private Sub sOK_Click() Dim i As Boolean Dim x As String i = Nz(DLookup("pass", "tblUsers", "pass = forms!frmsecurity!text2")) x = Nz(DLookup("UserId", "tblUsers", "pass = Forms!frmsecurity!text2")) If i = True Then If Stest = 1 Then myuser = x DoCmd.Close DoCmd.OpenForm "frmDrjat", acNormal Else myuser = "" DoCmd.Close DoCmd.OpenForm "frmDrjat", acNormal End If Else MsgBox "كلمة المرور غير صحيحة فضلاً تأكد وحاول مجدداً" Text2 = Null End If End Sub علما ان myuser هو متغير نصي تم الاعلان عنه في وحدة نمطية عامة و Stest متغير رقمي يمثل اول رقمين من كلمة المرور وطريقة الوصول الى الكود هو عند تشغيل المثال : نضغط على shift وفي نفس الوقت ننقر على البرنامج فيفتح على التصميم نفتح نموذج frmsecurity على التصميم ثم ننقر Alt+F11

الدرس الثالث نستكمل الموضوع السابق والذي تعرفنا فيه معا علي كيفية اضافة عناصر للفورم وكيفية مسح الفورم وتعرفنا ايضا علي اضافة عناصر للكمبوبوكس الان سوف نتعرف ماهو الفرق بين الكمبوبوكس والليست بوكس استخدام End للخروج من الفورم في الدرس السابق استخدمنا Unload Me استخدام caption لادراج عنوان للفورم اضافة عنا صر الي مربع القائمة الليست بوكس ************************************************************************************************* ماهو الفرق بين الكمبوبوكس والقائمة (الليست بوكس) الكمبو بوكس يحتوي علي عناصر يمكن رؤيتها عن طريق القائمة المنسدلة ويمكن رؤية عنصر واحد مرئي للمستخدم القائمة تعرض عدة عناصر بدون قائمة منسدلة ويمكن لللمستخدم الاختيار لعنصر او اكثر منها في وقت واحد الكمبيو بوكس يجمع بين خواص القائمة المنسدلة ومربع تحرير النص حيث يمكن للمستخدم الكتابة فيه القائمة (اليست بوكس ) تعطي المستخدم المزيد من الاختيارات المختلفة للعناصر مثال عندي مجموعة من البيانات تحتوي علي الأسم والطول كما يلي المطلوب عمل فورم لعرض رقم الصف المقابل للاسم يحتوي علي 1- ليست بوكس (لعرض الاسماء والاختيار منها ) 2- تكست بوكس (مربع نص) لعرض رقم الصف المقابل للاسم. 3-زر امر لتنفيذ الامر 4-زر خروج من الفورم باستخدام (( End )) خطوات العمل نقوم بتصميم فورم كما تعلمنا في الدرس الاول ونقوم بادراج ليست بوكس ومربع نص وزر امر للخروج وز امر لتنفيد امر كالتالي: الخطوة التالية اكواد الفورم 1- لاضافة عناصرالأسماء الموجودة عندي في ورقة العمل Sheet1 الي الليست بوكس والموجود في (("=Sheet1!A2:B10")) سوف استخدم الكود في حدث انطلاق الفورم واضيف عليها سطر العنوان للفورم كما ذكرنا في الدرس الاول باستخدام (Caption)) Private Sub UserForm_Initialize() ' اضافة العناصر لليست بوكس With ListBox1 .ColumnHeads = True .ColumnCount = 2 .ColumnWidths = "50;0" ' مصدر البيانات .RowSource = "=Sheet1!A2:B10" .MultiSelect = fmMultiSelectSingle .TextColumn = 1 .BoundColumn = 0 End With Me.Caption = "معرفة رقم الصف" End Sub وقي زر معرفة رقم الصف سوف اضيف مايلي Private Sub CommandButton1_Click() If ListBox1.Value <> "" Then TextBox1.Value = ListBox1.Value + 2 End If End Sub وفي زر خروج سوف نستخدم امر جديد (End) Private Sub CommandButton2_Click() End End Sub وبعد الأنتهاء سوف يكون شكل الفورم كما يلي وان شاء الله بعد الانتهاء من ادوات الفورم واستخدماتها وتنسيقاتها سوف نتطرا الي شرح الأكواد بالتفصيل ادعوا الله سبحانه وتعالي ان اكون قد وفقت في تبسيط المعلومة علي قدر المستطاع حتي يستفيد من الدروس اكبر قدر من المتابعين ولي رجاء عند المتابعة برجاء تطبيق الدرس اولا باولا وان كانت هناك اية اسئلة خاصة بالدرس اتمني سردها ورجاء اخر من اخواني بالمنتدي المشاركة ايضا لاثراءالموضوع حتي يكون عون للمبتدئين ويوفر الوقت في طلبات فورم ويقوم كل منهم بتصميم الفورم الخاص به وللموضوع بقية ان شاء الله >>>> التطبيق بالمرفقات مثال 3.rar

السلام عليكم الجزء الثاني Private Sub CommandButton2_Click() Application.ScreenUpdating = False On Error Resume Next If ComboBox1 = "" Then MsgBox "YOU HAVE TO CHOSE ITEME CODE FROM LIST FIRST", vbExclamation, "WRONG STEP" ComboBox1.DropDown ElseIf TextBox2 = "" Or TextBox3 = "" Or TextBox4 = "" Then MsgBox "YOU SHOULD FILL ALL FIELDS", vbExclamation, "EMPTY FIELDS" Else Beep If MsgBox("YOU ASKED TO MODIFY :" & vbNewLine & "" & vbNewLine & "CODE : " & ComboBox1 _ & vbNewLine & "" & vbNewLine & "NAME : " & TextBox2 & vbNewLine & "" & vbNewLine & "PRICE : " & TextBox3 & vbNewLine & "" & vbNewLine & "QU : " & TextBox4 & vbNewLine & "" _ & vbNewLine & "YOU WANT TO CONTINUE ?", vbYesNo + vbQuestion, "ENTRY CONFIRMATION") = vbYes Then Sheets("Sheet1").Select ActiveCell.Offset(0, 1).Value = TextBox2.Text ActiveCell.Offset(0, 2).Value = TextBox3.Text ActiveCell.Offset(0, 3).Value = TextBox4.Text Me.TextBox2.Text = "" Me.TextBox3.Text = "" Me.TextBox4.Text = "" Me.ComboBox1.Text = "" Me.Hide MsgBox "DATA HAS BEEN MODIFIED SUCCESSFULLY", vbInformation, "DONE" End If End If Application.ScreenUpdating = True End Sub 1. حدث الضغط على الزر وايقاف اهتزاز الشاشة والانتقال الى التالي عند الخطاء Private Sub CommandButton2_Click() Application.ScreenUpdating = False On Error Resume Next 2. شرط خلو ComboBox1 من البيانات (تظهر رسالة ) ويتم انزال القائمة المنسدلة If ComboBox1 = "" Then MsgBox "YOU HAVE TO CHOSE ITEME CODE FROM LIST FIRST", vbExclamation, "WRONG STEP" ComboBox1.DropDown 3. تنبيه خلو التيكست بوكس من القيم تظهر رسالة تنبيه ElseIf TextBox2 = "" Or TextBox3 = "" Or TextBox4 = "" Then MsgBox "YOU SHOULD FILL ALL FIELDS", vbExclamation, "EMPTY FIELDS" 4. في حالة عدم تحقق شرط خلو من البيانات تظهر رسالة من عدة أسطر وفيها خيار YES & NO Else Beep If MsgBox("YOU ASKED TO MODIFY :" & vbNewLine & "" & vbNewLine & "CODE : " & ComboBox1 _ & vbNewLine & "" & vbNewLine & "NAME : " & TextBox2 & vbNewLine & "" & vbNewLine & "PRICE : " & TextBox3 & vbNewLine & "" & vbNewLine & "QU : " & TextBox4 & vbNewLine & "" _ & vbNewLine & "YOU WANT TO CONTINUE ?", vbYesNo + vbQuestion, "ENTRY CONFIRMATION") = vbYes Then 5. عند إختيار YES وضع قيمة TextBox2 في نفس صف الخلية النشطة والعمود الاول بعدها و قيمة TextBox3 في نفس صف الخلية النشطة والعمود الثاني بعدها و قيمة TextBox4 في نفس صف الخلية النشطة والعمود الثالت بعدها Sheets("Sheet1").Select ActiveCell.Offset(0, 1).Value = TextBox2.Text ActiveCell.Offset(0, 2).Value = TextBox3.Text ActiveCell.Offset(0, 3).Value = TextBox4.Text ثم مسح قيم الموحودة في مربعات النص Me.TextBox2.Text = "" Me.TextBox3.Text = "" Me.TextBox4.Text = "" Me.ComboBox1.Text = "" وإخفاء الفورم وظهور رسالة تنبيهية بإتمام التعديل Me.Hide MsgBox "DATA HAS BEEN MODIFIED SUCCESSFULLY", vbInformation, "DONE" ان شاء الله اكون وفقت في الشرح ابواحمد

اخي طاهر سنبداء معاً شرح الكود جزء جزء وسننتقل من الجزء الى الاخر بعد فهم الجزء الاول إتفقنا الجزء الاول Private Sub ComboBox1_Change() Application.ScreenUpdating = False Sheets("Sheet1").Select For i = 2 To Sheets("Sheet1").ER If ComboBox1.Text <> Sheets("Sheet1").Cells(i, "A").Text Then TextBox2.Text = "" TextBox3.Text = "" TextBox4.Text = "" Else TextBox2.Text = Sheets("Sheet1").Cells(i, "B").Text TextBox3.Text = Sheets("Sheet1").Cells(i, "C").Text TextBox4.Text = Sheets("Sheet1").Cells(i, "D").Text Sheets("Sheet1").Select Sheets("Sheet1").Cells(i, "A").Select Exit For End If Next Application.ScreenUpdating = True End Sub أولاً هذا بخصوص التغير في ال ComboBox1 Private Sub ComboBox1_Change() 2. لمنع اهتزاز الشاشة Application.ScreenUpdating = False 3. إختيار ورقة العمل وهنا اسمها Sheet1 Sheets("Sheet1").Select 4. المتغير (وهنا يتم اعتماد تغير الصفوف ) ويبتدي من 2 وينتهي ب ER وER معرف لعد الصفوف المستخدمة في العمود A وستجده في كود Sheet1 For i = 2 To Sheets("Sheet1").ER 5. الشرط ويعني اذا كانت قيمة ComboBox1 لا تساوي اي قيمة في صفوف العمود A If ComboBox1.Text <> Sheets("Sheet1").Cells(i, "A").Text Then وينقسم الى حالتين أ. إذا تحقق الشرط يقوم بمسح القيم من TextBox3 و TextBox4 TextBox2.Text = "" TextBox3.Text = "" TextBox4.Text = "" ب. إذا لم يتحقق الشرط Else ينفذ التالي TextBox2.Text = Sheets("Sheet1").Cells(i, "B").Text TextBox3.Text = Sheets("Sheet1").Cells(i, "C").Text TextBox4.Text = Sheets("Sheet1").Cells(i, "D").Text Sheets("Sheet1").Select Sheets("Sheet1").Cells(i, "A").Select قيمة TextBox2 تساوي قيمة الخلية الموجوة في العمود B والصف (i) المتغير وهكذا بالنسبة TextBox3 والعمود C و TextBox4 و العمود D ثم إخيار ورقة العمل Sheet1 ثم اختيار الخلية (i, "A") 6. الخروج من For وانهاء الشرط وإعادة اهتزاز الشاشة Exit For End If Next Application.ScreenUpdating = True End Sub بإنتظار ردك على الشرح ابواحمد