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

السلام عليكم ورحمة الله وبركاته إخواني واحبابي في الله منذ ما يقرب من الستة أشهر وأنا أبحث عن كود أو دالة لايجاد الرقم التسلسلي للوحة الأم ، حيث يمكن استخدام الرقم التسلسلي لربطه بالمصنف كنوع من أنواع الحماية ... بحثت كثيراً وتجولت كثيراً ولم أيأس إلى أن وفقني الله عزوجل للحصول على دالة معرفة بعد معاناة كبيرة جداً في البحث .. وها أنا أقدمها لكم على طبق من ذهب .. ها هي الدالة المعرفة Function MBSerialNumber(Optional strComputer As String = ".") As String Dim V, vName, vUUID With GetObject("winmgmts:\\" & strComputer & "\root\cimv2") For Each V In .ExecQuery("SELECT * FROM Win32_ComputerSystemProduct", , 48) vName = V.Name vUUID = V.UUID Next V End With MBSerialNumber = vName & ", " & vUUID End Function ويمكن استخدامها من خلال ورقة العمل أو من خلال إجراء فرعي آخر بالنسبة لورقة العمل في أي خلية ضع المعادلة التالية =MBSerialNumber() وأخيراً إليكم الملف المرفق .. (يمكنك عدم التحميل ونسخ الدالة المقدمة ووضعها في موديول ... ولكن إذا أعجبك الموضوع فلا تبخل بالتحميل ، ولن يكلفك التحميل سوى دقيقتين فقط .. ولا تنسى أنني ظللت أبحث لمدة ستة أشهر) حمل الملف من هنا تقبلوا وافر تقديري واحترامي

السلام عليكم ورحمة الله وبركاته إخواني الكرام في موضوع للأخ الحبيب محمد حسن أبو يوسف ، قمت بعمل تصفية للبيانات بناءً على مربع نص ، إلا أنه في مشاركة للأخ الغالي رشراش علي أن الكود لا بعمل مع الأرقام ولا يعطي نتيجة ، كما أن الأخ أحمد أبو زيزو طلب مني شرح خطوات العمل فيما يتعلق بهذا الموضوع رابط الموضوع وبناءً على طلب إخواني ، وهم يدركون أنني لا أتأخر عليهم أبداً أقدم لكم موضوع اليوم فارتأيت (حلوة ارتأيت دي ... ) أن أخصص موضوع لهذا الأمر ، نظراً للطلب عليه ، ونظراً للفائدة المرجوة منه ، حيث أنه يسهل عملية البحث من خلال تصفية البيانات المطلوبة. يعتمد الملف المرفق على مثال بسيط للتطبيق ، تم إدراج مربع نص TextBox من خلال التبويب Developer ثم من Insert اختر مربع نص TextBox من القسم ActiveX Controls والبيانات المراد التعامل معها تبدأ من الخلية C3 وحتى آخر خلية بها بيانات... إليكم إخواني الكود مع شرح مبسط للأسطر عله يفيدكم Private Sub TextBox1_Change() 'يقوم الكود بالبحث في نطاق من خلال مربع نص ، وتصفية النتائج طبقاً للنص المدخل '[Insert] ثم من قائمة [Developer] من خلال التبويب [TextBox] قم بإدراج مربع نص 'ثم قم بإدراجه على ورقة العمل [ActiveX Controls] قم بالنقر على مربع النص الموجود في '-------------------------------------------------------------------------- 'تعريف المتغيرات والثوابت Dim LastRow As Long, RngFiltered As Range, I As Long, Arr Static Rng As Range 'إلغاء خاصية اهتزاز الشاشة Application.ScreenUpdating = False 'إلغاء الفلترة في ورقة العمل النشطة ActiveSheet.AutoFilterMode = False 'قيمة تظهر كل الصفوف لهذا النطاق [Static] إذا لم يكن للثابت المسمى If Not Rng Is Nothing Then Rng.EntireRow.Hidden = False 'تحديد آخر صف به بيانات في العمود الثالث LastRow = Range("C1000").End(xlUp).Row 'أي الخلية التي تسبق أول البيانات [C2] تعيين قيمة النطاق بداية من الخلية Set Rng = Range("C2:C" & LastRow) 'تعيين قيمة للمتغير من النوع مصفوفة ليساوي كل قيم النطاق Arr = Rng.Value 'إذا كان طول السلسلة النصية في مربع النص أكبر من صفر If Len(TextBox1.Text) > Then 'حلقة تكرارية لصفوف النطاق For I = 1 To UBound(Arr, 1) '[']إذا كان العنصر داخل المصفوفة رقمي يتم وضع علامة If IsNumeric(Arr(I, 1)) Then Arr(I, 1) = "'" & Arr(I, 1) Next I 'قيم النطاق تساوي القيم الجديدة في المصفوفة Rng.Value = Arr 'تصفية النطاق بشرط النص المدخل في مربع النص Rng.AutoFilter Field:=1, Criteria1:="=" & TextBox1.Text & "*" End If 'تعيين المتغير ليساوي الخلايا الظاهرة في النطاق Set RngFiltered = Rng.SpecialCells(xlCellTypeVisible) 'إلغاء الفلترة في ورقة العمل النشطة ActiveSheet.AutoFilterMode = False 'حلقة تكرارية لإعادة الأرقام للحالة الأولى بدون العلامة البادئة For I = 1 To UBound(Arr, 1) If Left(Arr(I, 1), 1) = "'" Then Arr(I, 1) = Mid(Arr(I, 1), 2) End If Next I Rng.Value = Arr 'إخفاء الصفوف للنطاق Rng.EntireRow.Hidden = True 'إظهار الصفوف للنطاق الذي تمت عملية التصفية على أساسه RngFiltered.EntireRow.Hidden = False 'إعادة تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = True End Sub أترككم مع الملف المرفق .. قوموا بتجربة الملف .. تم إدراج بيانات مختلفة نصوص باللغة العربية وباللغة الإنجليزية وأرقام ... حمل الملف من هنا تقبلوا تحياتي أخوكم ياسر خليل أبو البراء

جزاكم الله خيرا يا ابوالبراء كنت لسه ارفق لك الرابط لقيتك وصلت له جزاكم الله خيرا تقبل تحياتى

كلامك صحيح .. https://support.office.com/en-us/article/TEXTJOIN-function-357b449a-ec91-49d0-80c3-0e8fc845691c دا رابط فيه شرح للدالة .. بس الغريب النسخة اللي عندي متحدثة ..!! هراجع النسخة إن شاء الله بارك الله فيك وجزاك الله كل خير

شكرا أستاذ ياسر خليل ماشاء الله , اللهم زد وبارك فعلا , يمكن ربطها بالمصنف كنوع من الحماية وهذه النتيجة التي حصلت عليها بعد تطبيق الدالة : Latitude D620 , 4C4C4544-0038-4710-8058-B7Y0433334A وقد لفت انتباهي في الكود كلمة UUID وهي اختصار لكلمة Universal Unique Identifier المعرف الفريد العالمي والذي يهدف إلى أعطاء رقم خاص (كالمبين أعلاه) لكل جهاز من أجهزة الحاسوب حول العالم مهما اختلفت الشركات المصنعة لها مريدا من المعلومات على الرابط الآتي : https://en.wikipedia.org/wiki/Universally_unique_identifier

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

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

وعليكم السلام أخوي ابوحاتم 1. أضفت معيار حقل Class1 للنموذج Table1 ، الى الاستعلام الالحاقي: . 2. عملت الكود التالي على حدث "بعد التحديث للحقل Class1 في النموذج Table1 ، وياريت تتبع تفاصيله: Private Sub Class1_AfterUpdate() 'تأكد ان الحقل فيه رقم If Len(Me.Class1 & "") <> 0 Then 'هل هناك سجل في الجدول لهذا الرقم If DCount("*", "Table2", "[Class1]=" & Me.Class1) > Then 'لا تعطي رسائل تنبيه بالموافقة على الحاق سجلات DoCmd.SetWarnings False 'شغل الاستعلام الالحاقي DoCmd.OpenQuery "Table2 Query" 'اعطي رسائل تنبيه للاسطر التاليه DoCmd.SetWarnings True 'اطلب البيانات من الجدول من جديد للنموذج الفرعي Me.Table2_Subform.Requery 'اختر النموذج الفرعي Me.Table2_Subform.SetFocus 'اذهب الى آخر سجل ، والذي المفروض ان يكون السجل الجدي DoCmd.GoToRecord , , acLast End If 'Dcount End If 'Len End Sub . 3. اطلبك باقلة ودهن جعفر 351.d12003.2.mdb.zip

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

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

اخى الحبيب ابوالبراء الداله موجوده فى اوفيس 2016 وليست معرفه اعمل تحديث يا ابوالبراء من خيارات الاكسيل تقبل تحياتى

أخي الحبيب حسام أنا أعمل على أوفيس 2016 والدالة التي ذكرتها غير موجودة ربما تكون دالة معرفة .... بارك الله فيك وجزيت خيراً على التفاعل في الموضوع

استبدل الرقم 183 في السطر For i = 2 To 183 بـ 284 اليك الكود التالي الذي يقوم بنفس العمل و اسرع بكثير حيث انه يقوم بتجميع كل الاعمدة المطلوبة وحذفها دفعة واحدة Sub Delete_Zero() Dim rg_to_del As Range, i As Integer Application.ScreenUpdating = False For i = 2 To 284 If Cells(284, i) = 0 Then If rg_to_del Is Nothing Then Set rg_to_del = Cells(284, i) Else Set rg_to_del = Union(Cells(284, i), rg_to_del) End If End If Next i rg_to_del.EntireColumn.Delete Application.ScreenUpdating = True End Sub

وعليكم السلام الخطأ في الكود انك عاملت الحقل namee على اساس انه رقم ، بينما هو نص فيصبح الكود: If DCount("*", "Table1", "[id]=" & Me![List0].Column(1) & " And [namee]='" & Me![List0].Column(2) & "'") > Then وفي نفس الوقت كانت هناك مشكله في مكان العلامة " للمعيار لذا انا دائما اقسم الكود اى مجموعة اسطر ، سطر لكل معيار ، عليه هكذا تكون الاسطر: A = "[id]=" & Me![List0].Column(1) A = A & " And [namee]='" & Me![List0].Column(2) & "'" If DCount("*", "Table1", A) > Then جعفر

تفضل حبيبي الاخطاء وكان يوجد اكواد متبدله يعني زر= كان فيه كود المسح مثلا وزر 16 مكرر مرتين وطبعا لسه انت مكملتش القائمة يوجد بندين ناقصين وهما copy & Exit في القائمة File غير كدا كله تمام مجرد ترتيب اكواد فقط كل كود في الزر الخاص به يفضل الضغط على الزر من الخارج مرتين للدخول على الحدث الخاص به ووضع الكود بداخله لضمان وضع الاكواد في مكانها الصحيح بس تصميم رائع تقبل تحياتي WindowsApplication5.rar

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

اخى واستاذى الحبيب محمد الريفى جزاكم الله خيرا على كل ما تقدمه خدمه لاخوانك فى الوطن العربى وبخصوص الموضوع فى داله جديده من دوال اوفيس 2016 وهى TextJoin هى داله حديثه يمكن من خلالها عمل ذالك لكن للاسف ما عندى نسخه 2016م معرفه على جهازى لكى ارفق لك مثال تطبيقى اعتقد الداله هتكون بهذا الشكل =textjoin( "/";;A1:E1) ارجوا من الاخوة اللى عندهم 2016 يجرب ويعلمنى بالنتائج تقبلوا تحياتى

بسم الله ماشاء الله ربنا يبارك فيكم ويجزيكم خير حلول رائعه من اساتذه المنتدى سامحنى استاذى ابوالبراء فاننى (احبط ) احيانا نتيجة لعدم التفاعل -------. واليكم فهذه حلول متواضعه بجانب حلولكم والحقيقة كان هذا سؤال من احد الناس فوجدت انه يستاهل التفكير فاحببت ان اطرحه واشاركه معكم حتى نبدع جميعا واتمنى من الجميع تقديم المزيد والمزيد من الحلول الحل الاول =IF(MID(CONCATENATE(A1,IF(B1<>"","/",""),B1,IF(C1<>"","/",""),C1,IF(D1<>"","/",""),D1,IF(E1<>"","/",""),E1),1,1)="/", REPLACE(CONCATENATE(A1,IF(B1<>"","/",""),B1,IF(C1<>"","/",""),C1,IF(D1<>"","/",""),D1,IF(E1<>"","/",""),E1),1,1,""), CONCATENATE(A1,IF(B1<>"","/",""),B1,IF(C1<>"","/",""),C1,IF(D1<>"","/",""),D1,IF(E1<>"","/",""),E1)) الحل الثانى =A1& IF(AND(A1<>"",COUNTA(B1:E1)),"/","")& B1 & IF(AND(B1<>"",COUNTA(C1:E1)),"/","") & C1 & IF(AND(C1<>"",COUNTA(D1:E1)),"/","") & D1 & IF(AND(D1<>"",COUNTA(E1)),"/","") & E1 الحل الثالث دالة UDF وليست من اعدادى بل منقوله =ConcatRange(A1:F1,"/") Option Explicit Function ConcatRange(R As Range, Optional sDelim As String = " ") As String 'If no delimiter specified, delimiter will be a space Dim C As Range Dim V As Variant Dim COL As Collection Dim I As Long Set COL = New Collection For Each C In R If C <> "" Then COL.Add C.Text Next C ReDim V(0 To COL.Count - 1) For I = 0 To UBound(V) V(I) = COL(I + 1) Next I ConcatRange = Join(V, sDelim) End Function Concatenate%20formula.rar

(بارك الله بك اخي ياسر على هذه المعادلة الرائعة والتي لم تخطر على بالي (و انا بخبط راسي كي ابتدع حلاً مناسبا على كل حال هذا حل اخر بالكود (الصفحة My_sheet) Rifi_Salim 1.rar

أخي الحبيب محمد الريفي نشتاق لموضوعاتك الجديدة بشكل دائم ولتواجدك فيما بيننا لدي دالة معرفة تقوم بالأمر ولكني سأكتفي بهذه المعادلة البسيطة لتؤدي الغرض =SUBSTITUTE(TRIM(A1&" "&B1&" "&C1&" "&D1&" "&E1)," ","/") تقبل تحياتي

هذا احد الحلول Rifi_Salim.rar

بسم الله و ما شاء الله اللَّهُمَّ انْفَعْنَا بِمَا عَلَّمْتَنَا , وَعَلِّمْنَا مَا يَنْفَعُنَا , وَزِدْنَا عِلْمًا إِلَى عِلْمِنَا اهداء لكل من شارك بعلمه اقل ما يقال لكم "عندما تنتهى كلمات الابداع عندكم و تبدأ من جديد و تنتهى عندكم" بارك الله لكم مدونة اعمال ايقونات الماس لمنتدى اوفيسنا _ شارك بتعديلاتك فكرة المدونة هى سهولة الوصول و البحث فى المنتدى 1 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_برامج جاهزه ( حسابات_ميزان مراجعه_سندات قبض_يوميه) 2 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_بحث_اضافة_تعديل_ترحيل_ادخال 3 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_اكواد و معادلات و فورم 4 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_شاشة دخول_صلاحيات_PASS WORD 5 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_الاتصالات_الادارية_الموظفين 6 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_كنترول_امتحانات_لجان 7 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_الاكسيل الترفيهي 8 _ مدونة اعمال ايقونات الماس لمنتدى اوفيسنا_الاكسيل الاسلامى و لا تنسونا من صالح الدعاء و لامى بالمغفره و الرحمه

الظاهر صار وقت نومي صحيح ، والحل ان تنقل الكود من حدث "الحالي" الى حدث "التحميل" OnLoad: Private Sub Form_Current() End Sub Private Sub Form_Load() DoCmd.MoveSize 500, 500, 1000, 500 Me.InsideHeight = Me.InsideWidth = End Sub جعفر

يمكن ان يكون المطلوب اذا لم تعمل المعادلة استبدل فيها الفاصلة بفاصلة منقوطة معادلة جمع بشرط معطي salim.rar

اخى ابوحماده استخدم معادلة sumif حاليا لا استطيع رؤية الملف جرب تستخدم المعادله بالتوفيق

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

جزاك الله خيرا على كلماتك من تواضع لله رفعه " اللَّهُمَّ انْفَعْنَا بِمَا عَلَّمْتَنَا , وَعَلِّمْنَا مَا يَنْفَعُنَا , وَزِدْنَا عِلْمًا إِلَى عِلْمِنَا "

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

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

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

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

أكيد عدد الاحتمالات هيزي يعني لو اشتغلنا على الرقمين فقط وقلنا عايزين 4 خانات .. فيكون النتائج 2 ^ 4 =16 شوف إنت عايز كام خانة .. لو عايز 10 خانات من الرقمين فتكون الاحتمالات 2 ^ 10 وهكذا ..

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

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

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

والله أنت برررررررررنس شاكر لك أستاذي الحبيب تمت بنجاااح

وعليكم السلام اضف هذا الكود الى عمود جديد في الاستعلام: A: IIf([Degree]-Int([Degree])<0.5,Int([Degree]),Int([Degree])+0.5) هكذا: . والنتيجة: . جعفر 349.تقريب للنصف أو الواحد الصحيح.mdb.zip

استاذي ياسر خليل دائما تبهرنا بكل جديد

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

السلام عليكم حيا الله استاذ ياسر بصراحة كنت عندي شك 90 % بأن موضوع صعب التطبيق ، وكان في نفسي هم وقلق جزيت خيرا - وزادتك الله من فضله - ورزقك من حيث لا تحتسب شكرا - شكر - شكر

السّلام عليكم و رحمة الله و بركاته أخي الغالي " ياسر العربي " .. بعدما قمت بالمحاولة للآلة الحاسبة .. ظهرت لي مكتوبة 6 أخطاء .. ولم أجد الفورم أصلاً بهذا الملف المرفق .. لو تكرمت و ألقيت نظرة على الملف حاجة ثانية .. بحثت أخي الغالي عن الأداة FRAME .. أين أجدها لو سمحت فائق إحتراماتي WindowsApplication.rar

وعليكم السلام ورحمة الله وبركاته أخي الكريم جمال إليك الكود التالي عله يفي بالغرض حمل الكود من هنا تقبل تحياتي

بسم الله الرحمن الرحيم احبتي في الله اليوم باذن الله سنقوم بشرح كيفية ربط الفيجوال بيسك دوت نت مع الاكسيل نقوم بفتح برنامج الفيجوال بيسك دوت نت ثم نقوم بعمل مشروع جديد ونقوم باضافة عدد واحد تكست بوكس textbox وخمسة زر button ووضعهم كما بالصورة وطبعا نقوم من تبويب الخصائص الخاص بالادوات بالتعديل على اي اداة من حيث تغيير الاسم ولون الاداة وشكلها وحجمها وحجم الخط بداخلها وغيرها وغيرها من خواص هناك طرق عدة لربط برامج كثيرة بالفيجوال ومنها الاكسيل وسوف نشرح الطريقة التى احبها واعرفها ايضا وهي ما قمت بشرحها بسلسلة الفيجوال6 وان شاء الله الاختلاف بسيط ولكن الاساس واحد وهنعتمد على المراجع وهنختار المكتبة الخاصة بالاكسيل داخل المراجع بالفيجوال كما شرحناها سابقا ومن يريد معلومة اضافية يدخل على سلسلة الفيجوال6 يراجع نفس الدرس المذكور اعلاه وهو ربط الفيجوال بالاكسيل وهذا هو الرابط سلسلة دروس الفيجوال بيسك 6 الان نقوم بالذهاب الى قائمة البرنامج الرئيسية ونختار منها بروجيكت ثم Add Reference ثم نقوم باختيار com ومنها نختار المكتبة الخاصة بالاكسيل كما موضح بالصورة الان قمنا بتصميم مشروعنا وقمنا بتجهيز المكتبات اللازمة لعمل البرنامج ينقص الان كود عمل البرنامج نضع هذا السطر في اول الكود في ال General في التصريحات العامة يعني نفتح محرر الاكواد ونيجي على اول سطر بالظبط ونضع هذا الكود به السطر دا بيربط بين المرجع وبين البرنامج Imports Excel = Microsoft.Office.Interop.Excel ثم نقوم بالاعلان عن متغيرات لسهولة التعامل مع الاكسيل من داخل برنامجنا كما بالكود التالي ولقد قمنا بشرح مثله في سلسلة الفيجوال6 Public Class Form1 'نضع المتغيرات في بداية تصريحات الفورم 1 'المتغير الاول يشير الى برنامج الاكسيل Dim xlApp As Excel.Application 'المتغير الثاني يشير الى ملف مصنف الاكسيل Dim xlWorkBook As Excel.Workbook 'المتغير الثالث يشير الى ورقة العمل Dim xlWorkSheet As Excel.Worksheet End Class ثم نضع في حدث تحميل الفورم الكود التالي Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load xlApp = New Excel.ApplicationClass 'فتح برنامج الاكسيل جديد xlWorkBook = xlApp.Workbooks.Open("d:\test.xlsx") 'فتح ملف اكسيل xlWorkSheet = xlWorkBook.Worksheets("sheet1")'تم الاشارة للمتغير هنا بالورقة 1 xlApp.Visible = False'اخفاء البرنامج End Sub ثم نأتي للزر الاول وهو زر الادخال وهو ادخال القيمة الموجودة في تكست بوكس1 الى ملف الاكسيل في العمود A وكلما ادخلنا قيمة يضعها تحت الاخرى Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Dim last As Long'نقوم بانشاء متغير من نوع long 'قمنا بتعريف المتغير هنا على اساسا حساب عدد الصفوف بالعمود الاول التى يوجد بها بيانات بالاضافة +1 last = xlWorkSheet.Cells(xlWorkSheet.Rows.Count, "a").End(Excel.XlDirection.xlUp).Row + 1 'هنا نحدد الخلية a& last وهي اخر خليه بها بيانات بالاضافة 1 للكتابة في السطر التالي الفارغ قيمة ما بداخل التكست بوكس1 xlWorkSheet.Range("a" & last).Value = TextBox1.Text End Sub الكود التالي زر اظهار برنامج الاكسيل Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click 'كود سهل وهو اظهار برنامج الاكسيل xlApp.Visible = True End Sub الكود التالي زر اخفاء برنامج الاكسيل Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click xlApp.Visible = False End Sub الكود التالي زر حفظ التغييرات بملف الاكسيل Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click xlWorkBook.Save() End Sub الكود التالي اغلاق برنامج الاكسيل والغاء تعريف المتغيرات Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click xlWorkBook.Save() xlWorkBook.Close() xlApp.Quit() xlApp = Nothing xlWorkBook = Nothing xlWorkSheet = Nothing MsgBox("تم اغلاق ملف الاكسيل") End Sub وبكدا نكون انتهينا من شرح الكود وربط الاكسيل بالفيجوال وهذا هو الكود كامل Imports Excel = Microsoft.Office.Interop.Excel Public Class Form1 Dim xlApp As Excel.Application Dim xlWorkBook As Excel.Workbook Dim xlWorkSheet As Excel.Worksheet Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load xlApp = New Excel.ApplicationClass xlWorkBook = xlApp.Workbooks.Open("d:\test.xlsx") xlWorkSheet = xlWorkBook.Worksheets("sheet1") xlApp.Visible = False End Sub Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click xlApp.Visible = True End Sub Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click Dim last As Long last = xlWorkSheet.Cells(xlWorkSheet.Rows.Count, "a").End(Excel.XlDirection.xlUp).Row + 1 xlWorkSheet.Range("a" & last).Value = TextBox1.Text End Sub Private Sub Button5_Click(sender As Object, e As EventArgs) Handles Button5.Click xlWorkBook.Save() xlWorkBook.Close() xlApp.Quit() xlApp = Nothing xlWorkBook = Nothing xlWorkSheet = Nothing MsgBox("تم اغلاق ملف الاكسيل") End Sub Private Sub Button4_Click(sender As Object, e As EventArgs) Handles Button4.Click xlWorkBook.Save() End Sub Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click xlApp.Visible = False End Sub End Class انا قمت بوضع مثال لتكست بوكس فقط للتوضيح انا عايز منكم فهم الشرح وتطبيقه على نطاق اوسع شوية من المثال الموجود يعني عاوز برامج بجد شغل يعتمد عليه مش مجرد مثال يلا عايز اشوف شغل مش كلام ومش هحط مرفق نهائي الان لحد لما نشوف التفاعل والشغل تقبلو تحياتي ياسر العربي يتبع

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

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

أخي الحبيب أبو يوسف بارك الله فيك وجزاك الله كل خير على مبادرتك الطيبة ، ويعجبني أنك تجتهد حتى وإن فشلت ، فأنا أسعد بالمجتهد حتى ولو فشل آلاف المرات ... أخي الغالي سعد عابد أسئلة كثيرة .................. ولكن لعيون سعد (سعد سعد يحيا سعد) الفرق بين Value و Value2 لن أجيبك بشكل نظري بحت ولكن اعلم أن التاريخ يكتب في خلية ويظهر لك بشكل مختلف عن الشكل الأصلي الذي يقرأه الإكسيل اكتب أي تاريخ في الخلية A1 .... روح لمحرر الأكواد واضغط Ctrl + G عشان تفتح النافذة الفورية (يوجد موضوع لها في حلقات افتح الباب) ... في النافذة الفورية اكتب هذين السطرين (أنا قلت اكتب ولم أقل انسخ والصق ..بطل كسل) ?range("A1").Value ?range("A1").Value2 ولاحظ النتائج بنفسك السؤال الثاني هو الكلمة Redim وهي لإعادة تشكيل المصفوفة من حيث الأبعاد فوضعت هنا لكي أجعلها نفس أبعاد المصفوفة الأولى المسماة Arr .. السؤال الثالث لإضافة شروط .... الموضوع بسيط شايف السطر ده اللي فيه IF ..... If Arr(I, 1) >= startDate And Arr(I, 1) <= endDate Then قبل كلمة Then يمكن إضافة الشروط باستخدام كلمة AND ثم تضيف الشرط المطلوب .. ويمكن إضافة أكثر من شرط لا مشكلة في ذلك على الإطلاق أما بخصوص آلية الكود فهو يقوم بوضع قيم النطاق في مصفوفة ثم إنشاء مصفوفة أخرى لوضع النتائج المتوافقة مع الشروط الموضوعة وفي نهاية المطاف في آخر سطر يتم التعامل مع الإكسيل بوضع النتائج التي في المصفوفة Temp ووضعها في الخلية L10 أرجو أن تكون الإجابات قد أدت الغرض وأخيراً إليك شرح الكود في الموديول الثاني في الملف المرفق حمل الملف من هنا وتقبلوا وافر تقديري واحترامي

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

عليكم السلام والرحمة جرب هذا السطر وقم بتغيير الحقل date الى مسمى اخر لأنه من الكلمات المحجوزة في المثال انا غيرته الى ddate DoCmd.RunSQL "DELETE leave.* FROM leave WHERE d IN ( SELECT ddate FROM record)" بالتوفيق

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

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