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

اخواني الأعضاء الأساتذة الأحباء في المنتدى خلال بحثي عن دود الادخال الى أوراق الأشهر وجدتو ان تسمحو لي ان اقدم لكم كودان لانشاء أوراق العمل بأسماء الأشهر واحد للغة الانكلزيه والأخر ععمل حسب لغة الحاسوب المستخدم ارجو ان يستفيد الاخوة منه وتقبلو تحياتي اللغة الانكلزية Sub DoMonths() Dim J As Integer Dim K As Integer Dim sMo(12) As String sMo(1) = "January" sMo(2) = "February" sMo(3) = "March" sMo(4) = "April" sMo(5) = "May" sMo(6) = "June" sMo(7) = "July" sMo(8) = "August" sMo(9) = "September" sMo(10) = "October" sMo(11) = "November" sMo(12) = "December" For J = 1 To 12 If J <= Sheets.Count Then If Left(Sheets(J).Name, 5) = "Sheet" Then Sheets(J).Name = sMo(J) Else Sheets.Add.Move after:=Sheets(Sheets.Count) ActiveSheet.Name = sMo(J) End If Else Sheets.Add.Move after:=Sheets(Sheets.Count) ActiveSheet.Name = sMo(J) End If Next J For J = 1 To 12 If Sheets(J).Name <> sMo(J) Then For K = J + 1 To Sheets.Count If Sheets(K).Name = sMo(J) Then Sheets(K).Move Before:=Sheets(J) End If Next K End If Next J Sheets(1).Activate End Sub مختلف اللغات Sub DoMonths() Dim J As Integer Dim K As Integer For J = 1 To 12 If J <= Sheets.Count Then If Left(Sheets(J).Name, 5) = "Sheet" Then Sheets(J).Name = MonthName(J) Else Sheets.Add.Move after:=Sheets(Sheets.Count) ActiveSheet.Name = MonthName(J) End If Else Sheets.Add.Move after:=Sheets(Sheets.Count) ActiveSheet.Name = MonthName(J) End If Next J For J = 1 To 12 If Sheets(J).Name <> MonthName(J) Then For K = J + 1 To Sheets.Count If Sheets(K).Name = MonthName(J) Then Sheets(K).Move Before:=Sheets(J) End If Next K End If Next J Sheets(1).Activate End Sub الملفات مرفقة اوراق الاشهر بلغة الانكليزية.rar اوراق الاشهر بلغة جهازك.rar

السلام عليكم ما شاء الله ، ابداعات متنوعة و اثراءات مميزة للموضوع أسأل الله ان يديم علينا جميعا التواضع و حب الخير ، و أن يجعلنا من المتحابين فيه ، و الا ينزغ الشيطان بيننا

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

السلام عليكم اخي عادل هل تقصد بهذه الطريقة الرحلات.rar

السلام عليكم كود للفاضل سليم حاصبيا اتمنى ان يكون طلبك في حفظ الله salim.rar salim.rar

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

تفضل جرب المرفق اصناف1.rar

كل المعادلات تنزل فى الخلايا بالكود الحل في حجم ورقة الفاتورة 6.rar

الفيديو

كيف تستخدم دالة dcount لعمل الإحصائيات فى أكسيس؟السلام عليكميشرح هذا الفيديو دالة dcountو هى إحدى الدوال التجميعية فى أكسيستستخدم فى عد السجلات فى جدولعد كل سجلات جدولعد حقل معين بدون شرطعد حقل معين بشرط فى نفس الحقلعد حقل بشرط فى حقل آخرعد حقل بشرطين فى حقل أو حقلينالعد بشرط فى حقل نصى و الشرط الآخر فى حقل رقمىأرجو لكم الفائدةرابط الملف المستخدم فى الشرحhttps://drive.google.com/file/d/0Bw4...ew?usp=sharingجارى رفع الفيديو https://www.youtube.com/watch?v=_e10IKSpaAU&feature=youtu.be https://www.youtube.com/watch?v=_e10IKSpaAU&feature=youtu.be

جرب تغير حرف الـ k اللي هو Small خليه كابيتال .. بس خلاص

عدل المعادلة في الخلية E2 =IF($D2>=1000,($B2-$C2-$D2)/4,"") بالنسبة للجزء الثاني من الطلب غير واضح .. هلا وضعت أمثلة أخرى للتوضيح .. هل هناك ارتباط بين الصفوف؟

تعديل (بدون معلق و حول) Book salim (macro) adv.rar

بالنسبة للطلب الاخير يصبح الكود بالشكل Sub Macro1() Range("D6:I" & Range("D" & Rows.Count).End(xlUp).Row).AutoFilter Field:=2, Criteria1:="=" & Range("P4") Range("D6:I" & Range("D" & Rows.Count).End(xlUp).Row).AutoFilter _ Field:=1, Criteria1:="<>معلق", Operator:=xlAnd, Criteria2:="<>حول" End Sub

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

مرحبا هل تقصد بهذه الطريقة Book salim3.rar

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

لم افهم لغاية الان ما هو مفتاح السرد

جرب هذا الملف Book salim 1.rar

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

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

هو المطلوب وجزاك الله خيراااااااا كثير الف شكر استاذ ابو البراء

تفضل أخي الكريم وجرب الملف التالي Baraa Record V2.rar

اثراء للموضوع هذا الكود Sub InsertSheet() Dim arr() arr = Array("كانون الثّاني", "شباط", "آذار", "نيسان", "أيّـار", "حزيران", "تـمّوز", "آب", "أيلول", "تشرين الأوّل", "تشرين الثّاني", "كانون الأوّل") For i = 0 To UBound(arr) On Error Resume Next If Len(Sheets(arr(i)).Name) = 0 Then Sheets.Add.Name = arr(i) End If Next End Sub

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

ساوافيك بالمرفق ليلا اخي الكريم

الاستاذ الكبير / ياسر خليل أبو البراء الاخ admin_net بقصد بالطريقة الموضحة بالصورة التالية

الرقم الجديد - الرقم القديم - نفسه.rar اخي الكريم / محمد لؤي مرفق الملف بعد حل مشكلة كلمة نفسة و تم تعديل المعادلات في شيت بحث و اضافة معادلات في شيت اعتماد عمود H برجاء الاطلاع علي الملف

تفضل تم التعديل قليلاً على المعادلة Book salim.rar

اخي ياسر العربي اخي ياسر الخليل أبو البراء شكرا للمروركم الكريم الشكر للمنتدى الذي يجمعنا ويدر بالافائدة والخير على الجميع انشالله

أخي الكريم الحسام يوجد ورقة عمل مخفية باسم Conditions ، قم بإظهارها من خلال محرر الأكواد Alt + F11 وروح للخصائص الخاصة بهذا الشيت ..أي حدد الشيت من نافذة المشروع ، ومن نافذة الخصائص قم بإظهار ورقة العمل من الخاصية Visible اجعلها xlSheetVisiible تاني خطوة عدل نطاق الفصول من النطاق F14 لتزيد الفصول كما تريد .. وليكن 13 فصل ..إذاً ستقوم بكتابة الفصول من 1 إلى 13 أي من النطاق F14 إلى F26 الآن اذهب للتبويب Formulas ثم Name Manager ثم اختر النطاق المسمى ClassList ثم انقر Edit لتعديل مدى النطاق ، ستعدل رقم 18 إلى 26 ليشمل جميع الفصول ....

كيف تستخدم دالة dcount لعمل الإحصائيات فى أكسيس؟السلام عليكميشرح هذا الفيديو دالة dcountو هى إحدى الدوال التجميعية فى أكسيستستخدم فى عد السجلات فى جدولعد كل سجلات جدولعد حقل معين بدون شرطعد حقل معين بشرط فى نفس الحقلعد حقل بشرط فى حقل آخرعد حقل بشرطين فى حقل أو حقلينالعد بشرط فى حقل نصى و الشرط الآخر فى حقل رقمىأرجو لكم الفائدةرابط الملف المستخدم فى الشرحhttps://drive.google.com/file/d/0Bw4...ew?usp=sharingجارى رفع الفيديو

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

الحمد لله شكراً على مرورك أخى الفاضل

بارك على فيك على هذا المجهود و جزيت عليه خير الجزاء و بالتوفيق إن شاء الله

شكرا جزيلا أستاذ عبد الفتاح

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

جزاك الله خيرا

بارك الله فيك أخي عبد الفتاح

بارك الله فيك أخي أبو تامر كود جميل .. بالنسبة للنتائج لا تظهر منضطبة في بعض الأحيان في خلايا معينة وهي التي تكون منفردة (حيث تختفي علامة الدولار) مثال الصف رقم 3 حيث القيمة 0.17 بينما لم يظهر معها علامة الدولار إليكم حل آخر بدالة معرفة تقوم بجلب نص محدد من داخل الخلية Function GetElement(Str As String, Delim As String, Ordinal As Long) As Variant Dim strTxt() As String If Len(Str) = 0 Then GetElement = CVErr(xlErrNA) Exit Function End If If Len(Delim) > 1 Then GetElement = CVErr(xlErrNA) Exit Function End If If InStr(1, Str, Delim) = 0 Then GetElement = CVErr(xlErrNA) Exit Function End If If Ordinal <= 0 Then GetElement = CVErr(xlErrNA) Exit Function End If If Ordinal > Len(Str) - Len(Replace(Str, Delim, vbNullString)) + 1 Then GetElement = CVErr(xlErrNA) Exit Function End If strTxt = Split(Str, Delim) GetElement = Application.WorksheetFunction.Trim(strTxt(Ordinal - 1)) End Function استخدام الدالة : استخدم المعادلتين التاليتين : =GetElement(B2,")",1)&")" والثانية =GetElement(B2,")",2) أما فيما يخص الملف المرفق فأنا لا أرفق ملفات حتى يتعود الأعضاء تطبيق الحلول بأنفسهم .. وذلك لنرتقي ونتعلم تقبلوا تحياتي

تفضل اخى الملف يشتغل على 2003 وانا مستعد للرد على اى استفسار بشأن، الملف فهو مع حجم مدرستى الكبير سهل لى الامور قوائم 2003.rar

تحياتي للأخوة الاعزاء Sub Test_1() ' For x = 2 To Range("B" & Rows.Count).End(3)(1).Row vStrings_1 = Split(Cells(x, 2), "$", -1, vbBinaryCompare) vStrings_2 = Split(Cells(x, 2), ")", -1, vbBinaryCompare) Cells(x, 6) = Trim(vStrings_1(0)) Cells(x, 7) = Trim(vStrings_2(1)) Next ' End Sub Split PT Prices around the world_3.rar

يعطيك العافيه

شاهد المرفق Omar_1.rar

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

جرب هذا البرنامج واذا اعجبتك الفكرة اعد تصميم برامجك ارجو ملاحظة العلاقات لا ابالغ اذا قلت ان 70% من نجاح البرنامج تعتمد على العلاقات Counter.rar

هلا أرفقت ملف للعمل عليه ومحاولة تقديم المساعدة إذا أمكن

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

الأخ الكريم محمد لؤي السلام عليكم جرب المرفق التالى لعلك تجد فيه غايتك نسألكم الدعاء abo_abary_الرقم الجديد - الرقم القديم.rar

السلام عليكم الأخ الدكتور جابر المحترم ، تفضل الكود لقراءة المازربورد Private Sub cmd_Click() Dim objs Dim obj Dim WMI Dim strMBD Set WMI = GetObject("WinMgmts:") Set objs = WMI.InstancesOf("Win32_BaseBoard") For Each obj In objs MsgBox "MotherBoard Number: " & obj.SerialNumber Next End Sub مع وافر الاحترام