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

فى المرات القادمة حاول استاذ تامر ان تيسر على نفسك ولا تعسر كما نصحك جميع الأساتذة تفضل لك ما طلبت طبعا بعد ضبط تنسيقات وفورمات الملف =IFERROR(MAX(0,MIN(EOMONTH(0+(1&LOOKUP("zz",$L$1:L$1)),0),INDEX($C$3:$J$3,MATCH(L$2,$C$2:$J$2,0)+1))-MAX(0+(1&LOOKUP("zz",$L$1:L$1)),INDEX($C$3:$J$3,MATCH(L$2,$C$2:$J$2,0)))+1),0) 1تاريخ تواجد الموظفين.xlsx

الاخ mtoussa اليك بعض الملفات من احد المواقع المميزه ربما تفيدك او تفيد بعض الاخوة Template-Invoice-to-PDF.rar Online-PC-Learning-Invoice-Generator.rar Online-PC-Learning-Template-Email-Order.rar Template-Invoice-and-Stock-management.rar Template-Order_Matic.rar

تفضل لك ما طلبت مكافأة نهاية الخدمة.xlsx

أحسنت استاذ مجدى -عمل رائع بارك الله فيك

أخى الكريم المشكلة لديك فكل شيء يعمل معى بكفاءة وادخل بالفعل الى شيت الإكسيل

اهلا بك فى منتدانا الكريم -شرفتنا-تفضل لك ما طلبت تم عمل ايقونة على الفورم للدخول منها الى شيت الإكسيل بإستخدام هذا الكود Private Sub CommandButton2_Click() Application.Visible = True Sheet1.Activate Me.Hide UserForm1.Hide End Sub 1البواخر.xlsm

وعليكم السلام-فقط عليك استخدام هذا الكود Sub UnmergeAllCells() ActiveSheet.Cells.UnMerge End Sub

بارك الله فيك وزادك الله من فضله

عمل ممتاز-بارك الله فيك وزادك الله من فضله ورحم الله والديك

بارك الله فيك وزادك الله من فضله ورحم الله والديك

ربما كان المطلوب Trakiyat.xlsx

أخي المهندس: أختي المهندسة: السلام عليكم ورحمة الله وبركاته لاحظت من خلال عملي بالتخطيط أن معظم الأخوة المهندسين لايعلمون كثيرا عن طريقة سهلة وبسيطة من طرق التخطيط الا وهي طريقة Line of Balance وحتي من يعرف عنها شيئا فغالبا مايعرض عن إستخدامها لقد وجدت أن أقرب ترجمة لمصطلح Line of Balance هي "خطوط التوازن" لذلك رأيت أن أعرض عليكم شرح مبسط لمن يعمل علي تخطيط مشروعات ذات طبيعة تكرارية (وحدات – طوابق) ويريد أن يعرض البرنامج بوسيله هي أسهل في القراءة والمتابعة من الـ Bar Chart ..... أرجو من الجميع التجاوز عن أية أخطاء لغوية أو أخطاء طباعة ..... مقدمة بداية لابد من التفريق بين التخطيط Planning والجدولة Scheduling وبدون تفاصيل وفروق كثيرة بينهما، لايهمنا الآن إلا لفت النظر إلي أن التخطيط هو عملية ذهنية لابد أن يقوم بها البشر وليس الحاسب الآلي أما الجدولة فمن الممكن أن يقوم بها البشر وإن كان الأفضل لها الآن هو الحاسب الآلي طبعا تعتبر طريقة Line of Balance من أفضل طرق التخطيط لإظهار الأعمال المتكررة بصورة خطوط بسيطة توضح وقتي البداية والنهاية لكل نشاط علي مستوي المشروع ككل ، مثلا متي يبدأ نشاط خرسانة الأسقف ومتي ينتهي (طبعا علي مستوي المشروع وليس في وحدة واحدة) وهي كغيرها من طرق التخطيط تحتاج لممارسة حتي تعتادها وتستفيد منها ومع بساطتها إلا أنك لايمكنك إنتاج شكل الــ Line of Balance بدون ان تكون ملما وممارسا بعض الشيء لطرق التخطيط الأخري مثل طريقة المسار الحرج CPM ثم طريقة الــ Bar Chart ثم إستخدام أفضل طريقة للتعبير عن جدول المشروع وسوف نبدأ علي بركة الله من المرة القادمة حسب الفهرس الآتي: 1. متي يكون إستخدام طريقة الـ Line of Balance أفضل من غيرها 2. مثال لإستخدام الـ Line of Balance بدلا من الـ Bar Chart 3. الخطوات اللازمة (من الألف إلي الياء) لعمل خطوط التوازن لنفس المثال 4. كيفية المتابعة للـ Line of Balance 5. كيفية الإستفادة بهذه الطريقة لعمل برنامج بإستخدام البريمافيرا 6. الأساس لعمل برنامج بإستخدام البريمافيرا لمشروع ذو طبيعة تكرارية 7. عملية تسوية الموارد (Resource Leveling) وسيكون ذلك علي شكل قصاصات صغيرة صفحة واحدة أو إثنين علي الأكثر في كل مرة ليسهل هضم الموضوع والإستفادة منه وكل ما أرجوه ألا تنسونا من صالح دعاؤكم جعله الله في ميزان حسناتنا وحسناتكم أخوكم / طارق محمود

السلام عليكم و رحمة الله و بركاته في المرفق قاعدة بيانات تحتوي على ثلاثة نماذج احدهم يتحكم بفتح و إغلاق النموذجان المتبقيان .. قد تفيد هذه العملية في الشبكات , لمراقبة فتح و اغلاق نموذج معين و الاطلاع عليه عن بعد ان كان مفتوحآ أم مغلقآ و بالامكان التحكم بزيادة عدد النماذج المراقبة على قدر ما تحتاج .. راجيآ الدعاء النماذج المفتوحة حاليآ.accdb

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

بارك الله فيك اخ محمد هدية مقبولة وان شاء الله مزيداً من العطاء

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

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

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

السلام عليكم جرب المرفق الشهر تحط رقم 1 او 2 وهكذا Ali_Tst.xlsm

تفضل اخي العزيز ارجو ان يكون طلبك ConferenceDB-1.rar

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

استبدل الكود بـ Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("e:e")) Is Nothing Then With Target On Error GoTo 1 If Target <> "" Then .Offset(, -3) = "BFL" .Offset(, 2) = 0 .Offset(, 3) = "398" End If End With End If 1 End Sub أو Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("e:e")) Is Nothing Then With Target If Target.Count > 1 Then Exit Sub If Target <> "" Then .Offset(, -3) = "BFL": .Offset(, 2) = 0: .Offset(, 3) = "398" End If End With End If End Sub

جرب هذا الكود بعد اذن الاساتذه الافاضل Dim Ar() Dim i Private Sub Merg_Ali() Dim C As Range Dim A As String Dim B Sp False Erase Ar: i = 0 For Each C In ActiveSheet.UsedRange.Cells If C.MergeCells Then If i >= 1 Then If Ar(1, i) = C.MergeArea.Address Then GoTo nx End If i = i + 1 ReDim Preserve Ar(1 To 2, 1 To i) A = C.MergeArea.Address: B = C.Value Ar(1, i) = A: Ar(2, i) = B nx: C.UnMerge End If Next Sp True If i Then Ar = Application.Transpose(Ar) End Sub Private Sub Ad(A) Sp False For x = LBound(A, 1) To UBound(A, 1) Range(A(x, 1)) = A(x, 2) Next Sp True End Sub Sub Ali_Mr() Merg_Ali If i Then Ad Ar: Erase Ar: i = 0 End Sub Private Function Sp(Bl As Boolean) With Application .ScreenUpdating = Bl .EnableEvents = Bl End With End Function

بعد اذن الاخ علي جرب هذا الماكرو Sub UnMergeRange() Dim i%, k%, ro%, col% Dim MY_RG As Range, CEL As Range ro = Cells(Rows.Count, 1).End(3).Row col = Cells(2, Columns.Count).End(1).Column Set MY_RG = Range("A3").Resize(ro - 2, col) MY_RG.UnMerge For Each CEL In MY_RG If CEL = vbNullString Then _ CEL = CEL.Offset(, -1) Next MY_RG.Columns.AutoFit Set MY_RG = Nothing: Set CEL = Nothing End Sub

تفضل مع التنتسيق الشرطي sal_test 2.xlsx

فقط استخدم هذه المعادلة =IF([@[تاريخ اول تعيين]]="","",(TODAY()-[@[تاريخ اول تعيين]])/365) 1معلومات الكادر.xlsm

إلى السيد hamed12345 كلمة المرور هي : 1992

تم اضافة ماكرو للعمل على صفحة المطلوب 2 مع اضافة الاحتياط (باللون العادي) والأصليين باللون الأزرق الماكرو للصفحة المطلوب 2 Option Explicit Sub N_rand_For_matloub_2(col) 'Created by_salim 23/11/2019 'this code distribute teachers randomly Dim i%, m%, x%, k% Dim MY_max%, ro%, S_Rg As Range m = 8 Dim minn%: minn = 1 Dim maxx% Dim arr1(), arr2() Dim how_many Dim myArrayList As Object, myArrayList2 As Object MY_max = Cells(Rows.Count, 2).End(3).Row If Not IsNumeric([E2]) _ Or [E2] < 1 Or [E2] > 18 Then maxx = 18 Else maxx = Int([E2]) End If how_many = maxx - minn + 1 Range(col & 8, Range(col & 7).End(4)).ClearContents Set myArrayList = CreateObject("System.Collections.ArrayList") For i = 1 To maxx - minn + 1 myArrayList.Add Rnd(i) Next arr1() = myArrayList.toarray Set myArrayList2 = myArrayList.Clone myArrayList2.Sort arr2() = myArrayList2.toarray For i = LBound(arr2) To UBound(arr2) If i > how_many - 1 Then Exit For x = Application.Match(arr2(i), arr1, 0) Range(col & m) = x + minn - 1: m = m + 1 If m > MY_max - [f2] Then GoTo Exit_Me Next Exit_Me: '+++++++++++++++++++++++++++++++++++ For ro = 8 To MY_max Set S_Rg = Range(col & 8).Resize(maxx).Find(Cells(ro, 1), lookat:=1) If S_Rg Is Nothing Then Range(col & m) = "احتياط :" & Cells(ro, 1): m = m + 1 Next '++++++++++++++++++++++++++++++++++ Set myArrayList = Nothing: Erase arr1 Set myArrayList2 = Nothing: Erase arr2 End Sub '++++++++++++++++++++++++++++++++++++++++++++++++ Sub test_for_matloub_2() Dim arr, tt% arr = Array("D", "E", "F", "G", "H", "I", "J", "K", "L", "M") For tt = LBound(arr) To UBound(arr) Call N_rand_For_matloub_2(arr(tt)) Next Erase arr End Sub الملف من جديد Exam 1_2_new.xlsm

السلام عليكم حل آخر باستعمال أعمدة إضافية... بن علية حاجي قائمة منسدلة 2مطاطية.xlsx

جرب هذا الماكرو Option Explicit Sub N_rand_numbers_Between(col) 'Created by_salim 23/11/2019 'this code distribute teachers randomly Dim i%, m%, x%, k% m = 8 Dim minn%: minn = 1 Dim maxx%: maxx = [d2] Dim arr1(), arr2() Dim myArrayList As Object, myArrayList2 As Object Dim how_many If Not IsNumeric([d2]) _ Or [d2] < 1 _ Or [d2] > maxx - minn + 1 Then how_many = maxx - minn + 1 Else how_many = Int([d2]) End If Range(col & 8, Range(col & 7).End(4)).ClearContents For k = 1 To 3 Set myArrayList = CreateObject("System.Collections.ArrayList") For i = 1 To maxx - minn + 1 myArrayList.Add Rnd(i) Next arr1() = myArrayList.toarray Set myArrayList2 = myArrayList.Clone myArrayList2.Sort arr2() = myArrayList2.toarray For i = LBound(arr2) To UBound(arr2) If i > how_many - 1 Then Exit For x = Application.Match(arr2(i), arr1, 0) Range(col & m) = x + minn - 1: m = m + 1 Next Next Set myArrayList = Nothing: Erase arr1 Set myArrayList2 = Nothing: Erase arr2 End Sub '++++++++++++++++++++++++++++++++++++++++++++++++ Sub test() Dim arr, tt% arr = Array("D", "E", "F", "G", "H", "I", "J", "K", "L", "M") For tt = LBound(arr) To UBound(arr) Call N_rand_numbers_Between(arr(tt)) Next Erase arr End Sub الملف مرفق ضغطة واحدة على زر Run يتم التبديل كل مرة Exam 1_2.xlsm

وعليكم السلام-تفضل قائمة منسدلة 1مطاطية.xlsx

جرب هذا https://www.majnooncomputer.net/افضل-10-برامج-استعادة-الملفات-المحذوفة/ والسلام عليكم

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

اتفضل احى الحبيب هذا الفيديو التوضحيى لادارج الازرار ادراج_الازرار.rar

الحمد لله هذا هو المطلوب بس لو امكن اضافه بحيث يكون العمل ااخر مدى فيه بيانات في العمود (D) علما بانه بعض الصفوف بتكون فارغه ليس بها بيانات

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

الف شكر استاذي العزيز تقريبا نفس الذي اريده لكن للاسف لم اعرف كيف الطريقة التي تم عمل مربع التحرير والسرد بها بهذه الطريقة ولكن اريد تطبيقه على محرك بحث بالمرفق نموذج عن قاعدة البياانات realestate.rar

تحياتى و ايام مباركه مرفق كود مرن و هام يقوم باستدعاء الفورم بدبل كليك يمكن الاستفاده منه فى اى برنامج او ملف ( و هو منقول من ضمن مشاركات المنتدى ) فمثلا لو عندك فورم بحث و اضافة مطلوب استدعائه فى نطاق معين لادخال و تكويد بيان معين بدلا من استخدام القائمه المنسدله فضع هذا الكود البسيط فى حدث الصفحه المطلوبه Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("a1 : a1", "b2 : b2230")) Is Nothing Then Cancel = True UserForm1.Show End If End Sub فعند الضغط / الكابس دبل كليك على الخانه A1 او النطاق B2:B2230 يتم استدعاء فورم او ليست اسمه userform1 تحياتى و لا تنسونا من صالح الدعاء G_Double click.rar

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

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

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

بسم الله الرحمن الرحيم اليوم سنقوم بشرح طريقة ربط الفيجوال بيسك بالإكسيل اولا نعمل مشروع جديد عبارة عن فورم وواحد كمبوبوكس وسته تكست وثمانية ليبل وخمس أزرار وملف اكسيل بامتدادxlsx واسمه aseel امتداده اظن لا يدعم وحدات الماكرو بس عادي مع الفيجوال شغال بنفس ترتيب الشكل الاتي: خلصنا الشكل السابق ندخل علي الشغل الجديد بقي كلنا أكيد سمعنا عن المتغيرات وكلنا تعاملنا معاها قبل ما نشوف المتغيرات الفيجوال عشان نربطه بالإكسيل لازم له مراجع ومتغيرات عامة على مستوى المشروع بأكمله إيه الكلام دا بيتعمل ازاي المرجع دا ولا بنجيبه منين شوفو معايا الصور بعد الخطوات دي ياترى بنعرف نضيف موديول زي ما بنضيف فورم جديد كدا اللي بيعرف يضيف اللي مش عارف ينزل للصورة معايا ويشوف ايه البيانات دي يامعلمين دي بقي المتغيرات العامة اللي بنقول عليها وبتكون علي مستوى المشروع بأكمله يعني لازم تتحط في موديول ولتبسيط الكلام اللي فوق دا بطريقة سهلة اول سطر Public YXL As New Excel.Application YXL دا متغير يشير الى برنامج الاكسيل نفسه بمعنى عندما نريد ان نكتب في الاكسيل Application. Visible = False نكتبه كدا YXL. Visible = False اكيد وصلت الفكرة ولو مش وصلت نكمل مثال كمان المتغير ونظيره في الإكسيل YWB= Workbook YSheet= Worksheet YRng= Range اكيد الامور اصبحت سهلة كدا أي كود في الإكسيل نستبدل المذكورين في أعلاه بنظره في الإكسيل وسيعمل الكود بإذن الله يعني مش هتخترع اكواد جديدة هي نفس القديمة بس تعديلات طفيفه المهم الكل يكون عمل الفورم والموديول والاداوت كما ذكرت سابقا بالترتيب الموجود عشان الاكواد متتبدلش مع الادوات نيجي بقي للاكواد Private Sub Combo1_Click() 'جدا الكمبوبوكس ومنه بيتم جلب البيانات بمعلومية الرقم والكود طبعا مفيهوش جديد نفس اكواد الاكسل With YSheet LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row For iRow = 6 To LastRow If .Cells(iRow, 2) = Combo1.Text Then Text1.Text = .Cells(iRow, 2) Text2.Text = .Cells(iRow, 3) Text3.Text = .Cells(iRow, 4) Text4.Text = .Cells(iRow, 5) Text5.Text = .Cells(iRow, 6) Text6.Text = .Cells(iRow, 7) End If Next End With End Sub Private Sub Command1_Click() Dim lstrow As Long 'ودا كود ترحيل البيانات ونفس الشئ مش جديد كل اللي اتغير اللي ذكرنااه If Text1.Text = "" Then MsgBox "íÌÈ ÇÏÎÇá ÌãíÚ ÇáÈíÇäÇÊ" Else lstrow = YSheet.Range("b20000").End(xlUp).Row + 1 YSheet.Cells(lstrow, "b").Value = Text1.Text YSheet.Cells(lstrow, "c").Value = Text2.Text YSheet.Cells(lstrow, "d").Value = Text3.Text YSheet.Cells(lstrow, "e").Value = Text4.Text YSheet.Cells(lstrow, "f").Value = Text5.Text YSheet.Cells(lstrow, "g").Value = Text6.Text Text1.Text = "" Text2.Text = "" Text3.Text = "" Text4.Text = "" Text5.Text = "" Text6.Text = "" MsgBox ("ÊãÊ ÇáÚãáíÉ ÈäÌÇÍ") End If End Sub Private Sub Command2_Click() 'ودا كود اظهار برنامج الاكسيل بردو غيرنا اللي اشرنا ليه فقط YXL.Visible = True End Sub Private Sub Command3_Click() ' ودا لاخفاء برنامج الاكسل YXL.Visible = False End Sub Private Sub Command4_Click() 'لحفظ البرنامج المفروض المتغير يكون شغال بس مش عارف سبب المشكلة ايه حاليا فقلت اجرب الكود العادي اشتغل تمام مشي حالك 'åäÇ ãÔ ÚÇÑÝ ÇáãÊÛíÑ åäÇ ÞÝÔ ãÚÇíÇ æãÔ ÚÇíÒ íÍÝÙ ÞáÊ ÇÌÑÈ ÇáßæÏ ÇáÚÇÏí ÇÔÊÛá ÞáÊ Òí ÇáÝá 'YWB.save ActiveWorkbook.save End Sub Private Sub Command5_Click() 'وطبعاخروج YXL.Quit Set YXL = Nothing End End Sub Private Sub Form_Load() 'هنا بنستدعي ملف الاكسيل من نفس مسار البرنامج بتاعنا ونفتحه YXL.Workbooks.Open App.Path & "/aseel.xlsx" 'اخفاء البرنامج بعد فتحه طبعا YXL.Visible = False 'هنا بقي قولنا له ان يخلي Ysheet دي تبقى الشيت الاول والاكس شيت تبقي الشيت التاني Set YSheet = YXL.Worksheets(1) Set XSheet = YXL.Worksheets(2) عادي ليبل وبياخد بياناته من خليه معينه Label7.Caption = YSheet.Range("a1").Value Label8.Caption = YSheet.Range("a2").Value With Combo1 'ودا ا لكمبوبوكس بندرج فيه بيانات الصف b For Each Data In YSheet.Range("b6:b" & YSheet.Cells(Rows.Count, "b").End(xlUp).Row) .AddItem Data Next End With End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) ودا بقي عشان لما تدوس علي علامة الاكس فوق ميخرجشي من البرنامج ويسيب ملف الاكسيل مفتوح ومخفى '' YXL.Quit Set YXL = Nothing End End Sub وبكدا نكون انتهينا من وضع الاكواد اظن الكل واخد باله انه مفيش جديد وهو دا بالتحديد مفيش جديد كل اللي عملناه واحد تايه وعرفنا السكه خلاص وبعدين محدش ينسى يعمل ملف اكسيل اه بعد دا كله يجي حد يقولي البرنامج مش شغال ليه اقوله فين ملف الاكسيل بعد الاطلاع علي البرنامج هيجي واحد يقولي ايه القلب الجميل اللي علي الفورم دا اللي مكان السهم اهو دا من ضمن اللمسات الجمالية وبيتعمل ازاي يامعلم الشرح بسيط ف الصورة معلش بدل ما اكتب الماوس كتبت الموس شغال بقى اعذروني انا بعمل الشرح في وقت قياسي وانا شغال مرفق البرنامج ومعاه القلب عشان تعملوه مكان السهم يارب اكون وصلت المعلومة صح واي خطأ منى فدا لجهلى اعذروني منتظر الردود علي فكرة الدرس دا تقريبا بنسبة كبيرة يعتبرحصرى لمنتدى اوفيسنا انا بحثت عن ربط الفيجوال بالاكسيل كثيرا وكثيرا وكود من هنا وكود من هنا حتى اكتملت الصورة امامي وتوصلت لهذا والحمد لله مع تحياتي ياسر العربي يتبع ربط الفيجوال بالاكسل.rar

السلام عليكم اخى الكريم يمكنك استخدام احد المعادلتين التاليتين =SUMIFS($B$4:$B$24;$A$4:$A$24;">="&$A$27;$A$4:$A$24;"<="&$B$27) =SUMPRODUCT(($A$4:$A$24>=$A$27)*($A$4:$A$24<=$B$27);$B$4:$B$24)

دالة لجعل مسلسل الارقام تلقائى دالة لجعل مسلسل الارقام تلقائى.rar

تماما أخي جمال أجريت تعديل بسيط و أصبح على الشكل التالي : =IF(B2<>"","PO"&"-"&COUNTIF($B$2:$B2,$B2),"") لك جزيل الشكر و التقدير يا غالي

أستخدم هذه المعادلة وأسحبها لأسفل بفرض أن عمود التسلسل فى ( A2) والبيانات فى ( B2 ) وهكذا =IF(B2<>"";COUNTIF($B$2:$B2;$B2);"") ويمكن إستخدام هذه المعادلة مع إضافة مزيد من الشروط لو أردت =IF(SUMPRODUCT((DATA1=B2)*(DATA1<>""));COUNTIF($B$2:$B2;B2);COUNTA($A$2:$A2)) تقبل تحياتى تسلسل خاص.rar

تكرم عينك اخي ابوخليل ولكن في البداية لابد من التوضيح بان هذه الدالة استقيتها من مثال اجنبي ولا اريد ان اسند لنفسي فضل ليس لي ولكن من بساطتها يمكن فهمها بسهولة... والان الى الشرح Public Function Horizontal(tabelle As String, Feld1 As String, Feld2 As String, valFeld1) هذا سطر تعريف الدالة ومتغيراتها والتي تتمثل في اسم الجدول او الاستعلام , اسم الحقل المراد التجميع بحسبه , اسم الحقل الذي سيتم تجميعه , اسم الحقل الذي سيرتبط به حقل التجميع (وأعتقدانه يمكن فهمها اكثر من واقع المثال) Dim DB As Database, rs As Recordset Set DB = CurrentDb هنا يتم تعريف متغيرين الأول من نوع Database أي قاعدة بيانات (وجعلناها قاعدة البيانات الحالية التي نعمل بها) والثاني rs من نوع Recordset وهذا النوع من المتغيرات وبشكل مبسط يمكن تعريفه كأنه جدول أو إستعلام Set rs = DB.OpenRecordset("select distinct " & Feld2 & " from " & tabelle _ & " where " & Feld1 & "='" & valFeld1 & "' order by " & Feld2) هنا اسندنا للمتغير rs جملة SQL التي تمثل مصدر بياناته Do If rs.AbsolutePosition = rs.BOF Then هذه بداية الحلقة التكرارية التي ستتنقل بين سجلات الـ Recordset ثم تقوم جملة IF هنا بإختبار ما إذا كان موقع السجل الحالي (AbsolutePosition) في بداية (BOF) الـ Recordset Horizontal = rs(Feld2) عندها يجعل النتيجة تمثل قيمة الحقل المجمع Else Horizontal = Horizontal & ", " & rs(Feld2) End If وإلا تكون النتيجة هي قيم الحقل المجمع في السجلات السابقة مضافاً اليها الفاصلة (ويمكن تعديلها بما تشاء) ثم قيمة الحقل المجمع للسجل الحالي rs.MoveNext الإنتقال للسجل التالي Loop Until rs.EOF إختبار ما إذا وصلت الحلقة التكرارية إلى آخر سجل (EOF) في الـ Recordset rs.Close DB.Close Set rs = Nothing Set DB = Nothing End Function عندها يتم إغلاق الـ Recordset و الـ DB وتصفية الذاكرة من أي قيم محفوظة فيها وإنهاء الدالة هذا شرح مبسط فأرجو أن يكون واضح تحياتي,,,

بعد اذن الاخ nart lebzo تفضل اخي مثالك بعد التعديل تحياتي,,, base.rar

السلام عليكم ورحمة الله هذه الدالة SUBTOTAL أنها تستعمل مع دوال أخرى (في حالة الخلايا المخفية وغير المخفية) بالنسبة لطلبك يمكنك أن تقوم بتطبيق التصفية مثلا إذا كانت بعض مضامين الخلايا الموجودة في العمود الثاني متساوية وتختارها في التصفية تقوم الدالة بالترقيم تلقائيا ترتيبا تصاعديا... وإذا أردت أن تقوم الدالة بالترتيب في حالة إخفاء الأسطر ما عليك إلا أن تستبدل الرقم 3 الموجود في المعادلة بالرقم 103 مع سحب المعادلة على طول العمود وقم بإخفاء الأسطر التي ترتيدها وسترى أن الترقيم سيكون تلقائيا وبالترتيب التصاعدي أبدل في الحالة الصيغة : =+SI(B2="";"";SOUS.TOTAL(3;B2:B$2)) بالصيغة: =+SI(B2="";"";SOUS.TOTAL(103;B2:B$2)) والله أعلم

السلام عليكم ورحمة الله وبركاته كنت نويت التوقف حيث لم أجد تشجيع ولكن وإن لم يكن يقرأ ذلك غير الأخ abosdaira والأخ Emad_sam (وهما من علقا عليه وطلبا المزيد) علي كل حال وإستكمالا للمثال في المرة السابقة لموضوع التخطيط بطريقة خطوط التوازن: الــ Line of Balance اليوم سنتعرف بإذن الله علي وفيما يلي الخطوات اللازمة (من الألف إلي الياء) لعمل خطوط التوازن لنفس المثال السابق • بداية يتعين معرفة وتحديد معدل تنفيذ كل نشاط علي الوحدة من وحدات المشروع وليكن 2 +5 +3 +5 أسابيع لكل بناية علي حدة لأنشطة القواعد والمباني وأعمال السطح والتشطيبات الداخلية علي الترتيب أنظر الشكل (3) المرفق • وأيضا يتعين معرفة وتحديد عدد الوحدات (4 في المثال) والوقت اللازم لإنهاء المشروع milestone (20 أسبوع في المثال) متقاطعان بالنقطة (و) • ثم يتم بعد ذلك عمل نقاط بداية الأنشطة ماعدا آخر نشاط علي محور س: (الزمن) 0 ، 2 ، 7 ، 10 = 0 ، 0+2 ، 2+5 ، 7+3 بمعني أنه إذا بدأ النشاط الأول (القواعد) للبناية الأولي عند الصفر فتكون بداية النشاط الثاني (المباني) للبناية الأولي عند نهاية الأسبوع الثاني و بداية النشاط الثالث (أعمال السطح) عند نهاية الأسبوع السابع وهكذا (لاحظ الأسهم الحمراء علي محور س) • نوصل آخر نقطة علي محور س بالنقطة (و) عن طريق خط وهذا هو آخر نشاط ينتهي لآخر بناية بوقت إنتهاء المشروع milestone • ثم نبدأ رجوعا علي محور موازي لمحور س عند آخر بناية (4) وبداية من النقطة (و) بتوقيع نقاط نهاية الأنشطة 20 ، 15 ، 12 ، 7 = 20 ، 20-5 ، 15-3 ، 12-5 (لاحظ الأسهم الزرقاء علي محور س+4 ) • نوصل كل نقطة علي محور س +4 بالنقطة المقابلة علي محور س و في المرة القادمة إن شاء الله : كيفية المتابعة لخطوط التوازن Line of Balance والسلام عليكم ورحمة الله وبركاته ونسألكم الدعاء طارق محمود