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

وعليكم السلام تفضل اخي الكريم هل هذا هو المطلوب؟ بالتوفيق برنامج الحضور والغياب للطلاب بالباركود.accdb

السلام عليكم اعضاء واساتذة منتدانا الغالي هذه محاولة وتعديل لمشاركة احد الاخوة الكرام فيما يخص الصلاحيات لقاعدة البيانات اكواد تشفير الرقم السري هي نفسها المستخدمة سابقا بالاضافة مع الاستعانة ببعض الشروح ملاحظة : في القاعدة اربعة مستخدمين ثلاثة منهم بصلاحيات محدودة والادمن بصلاحيات كاملة اسم المستخدم كلمة السر admin 0 A 1 B 2 C 3 Root1000.rar

السلام عليكم تقضل طلبك كما في الصورة بعد التعديل مرفق ملفك تحياتي برنامج الحضور والغياب للطلاب بالباركود.rar

🙂

السبب هو عدد الحقول التي طلبتها ، اضف العلامة | في الدالة NZ ، بعددها في الكود بمعنى عندك 9 علامات : فلازم NZ يكون : جرب هذا A = Nz(DLookup("[ITEM_CODE] & '|' & [deskwn1] & '|' & [item_name] & '|' & [Expr1]& '|' & [Expr2] & '|' & [sub_id] & '|' & [FACTOR]& '|' & [UNT_ID]& '|' & [ITEM_CommissioN]& '|' & [CATEGORY]", "VW_ITEM_MASTAR", "[ITEM_BARCODE]='" & Me.ITEM_BARCODE & "'"), "|||||||||") جعفر

تفضل اكتب اي كلمة test34.xlsm

Try this file Offecna.xlsx

شاهد هذا الفيديو https://www.youtube.com/watch?v=0YNhxVu2a5s

اتفضل اخى حسين Me.EDET_QOTY = DLookup("[Qote_item]", "tabol102", "item_prais=" & [item_prais] & "and [ITEM_BARCODE]='" & Me.serh_Barcod & "'") DCount("ITEM_BARCODE", "tabol102", "ITEM_BARCODE = forms!forms_1!serh_Barcod and [item_prais]=forms!forms_1![item_prais]") test_1.accdb

جرب هذا الملف Ages.xlsx

بسم الله الرحمان الرحيم و الصلاة و السلام على أشرف المرسلين أما بعد: سوف نقوم اليوم إن شاء الله بشرح أداة WebBrowser وأهم ما يتعلق بها من أوامر و أحداث و خصائص و إدخال و إخراج. و سوف يتم تقسيم هذا العمل إلى مجموعة حلقات نبدأ من الصفر حتى آخر نقطة نستطيع الوصول إليها إن شاء الله مع وضع مثال تطبيقي لكل حلقة. مقدمة: WebBrowser هي أداة تعمل عمل أي متصفح و هي مقترنة المتصفح الشهير Internet Explorer فهي تساعدك في تصفح المواقع من ناحية و التحكم في أكواد HTML وكل ما يرتبط بها من إدخال و استخراج بيانات من ناحية أخرى. ملاحظة: لتشغيل هذه الأداة بشكل جيد يجب تحديث المتصفح الشهير Internet Explorer إلى الإصدار 10 أو 11. مع العلم أن ونداوز 10 به الإصدار 11 الحلقة الأولى: أكواد التصفح سوف نتطرق في هذه الحلقة إلى الأكواد التي تمكننا من التصفح و التنقل داخل الأداة. 1- كود فتح صفحة موقع: WebBrowser3 هو اسم الأداة داخل النموذج Me.WebBrowser3.Navigate ("رابط الصفحة كامل") 2- كود فتح صفحة فارغة: Me.WebBrowser3.Navigate ("about:blank") 3- كود الرجوع للصفحة السابقة: Me.WebBrowser3.GoBack 4- كود الإنتقال للصفحة التالية: Me.WebBrowser3.GoForward 5- كود إعادة تحميل الصفحة: Me.WebBrowser3.Refresh 6- كود إيقاف تحميل الصفحة: Me.WebBrowser3.Stop 7- كود إستخراج رابط الصفحة الحالية: MsgBox Me.WebBrowser3.Document.url و هذا مثال لما تم ذكره في هذه الحلقة webbroser.rar

السلام عليكم 🙂 اخواني ، الجميع يساعد في المنتدى بوقته وبدون مقابل ، وعندنا مثل يقول: حبة الزبيب ما تشبّع ، ولكنها تحلّي الفم 🙂 فرجاء خلونا نشجع الاعضاء في العطاء 🙂 لما تحصل على رد له قيمة ، فتشجيعا للعضو الذي يساعدك ، اخبر العضو بأنك مُعجب برده ، هكذا : . . ولما تحصل على اجابة لسؤال موضوعك ، فرجاء اختيار افضل اجابة ، هكذا (حتى مستقبلا يسهل معرفة الاجابة الصحيحة) : . شكرا 🙂 جعفر ومع الاعتذار لأخي احمد لإستخدام اسمه في المثال 🙂

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

بعد اذن استاذ محمد يتم الترحيل بعد تنشيط الورقة باسم all test_2.xlsm

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

1. نحن في النموذج Form1 ، ونريد ان نستعمل القيم من النموذج المفتوح Form2 : Me.ITEM_BARCODE = DLookup("[ITEM_BARCODE]", "VW_ITEM_MASTAR", "[ITEM_BARCODE]='" & Forms!forms1!serh_Barcod & "'") Me.ITEM_CODE = DLookup("[ITEM_CODE]", "VW_ITEM_MASTAR", "[ITEM_BARCODE]='" & Forms!forms1!item_no & "'") 2. نحن في النموذج Forms2 ، ونريد ان نرسل القيم الى النموذج المفتوح Forms1 : Forms!forms1!serh_Barcod = DLookup("[ITEM_BARCODE]", "VW_ITEM_MASTAR", "[ITEM_BARCODE]='" & Me.ITEM_BARCODE & "'") Forms!forms1!item_no = DLookup("[ITEM_CODE]", "VW_ITEM_MASTAR", "[ITEM_BARCODE]='" & Me.ITEM_CODE & "'") جعفر

تسلم استاذ نبيل جزاك الله كل خير لقد فعلت ما اريده بنجاح سلمت يداك 💙💙

اولا : اخي احمد اشكرك وادعوا الله لك بالتوفيق ثانيا : استقطاع وقتك لمساعدة الاخرين تؤجر عليه لا حرمك الله الاجر وربي يجعلها في ميزان حسناتك ثالثا : هل ممكن في القاعدة السابقة نسطيع استبدال ( صواب - خطأ ) بكلمة نعم / لا وجزاك الله خيرا

تفضل 🙂 الدالة NZ تحل المشكلة 🙂 A = Nz(DLookup("[SELLS_PRICE]& '|' & [item_name]", "POS_MASTER", "[ITEM_BARCODE]='" & Me.ITEM_BARCODE & "'"), "|") x = Split(A, "|") Me.SELLS_PRICE_2 = x(0) Me.ITEM_NAME_2 = x(1) جعفر

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله عنا كل خير والحمدلله الذى بنعمته تتم الصالحات بالتاكيد هذه الهديه من روائع اخى واستاذى جعفر ويسرت على ايضا كثيرا جزاك الله عنا كل خير لما استخدمته جعلته فى حال لم لم يجد قيم فيضع اصفار فالحقول كالتالى LN = DLast("[Post] & '|' & [Mtar] & '|' & [EmsD] & '|' & [EmsKh] & '|' &[Draeb]", "THrkat_Emp", "[THrkat_Emp.KodT]=[TKhtotKodT] and [THrkat_Emp.ID_Kind ]='N3'") If IsNull(LN) Then LN = ("0 | 0 | 0 | 0 | 0") X = Split(LN, "|") Me.[LPost] = X(0) Me.[LMtar] = X(1) Me.[LEmsD] = X(2) Me.[LEmsKh] = X(3) Me.[LDraeb] = X(4) Else X = Split(LN, "|") Me.[LPost] = X(0) Me.[LMtar] = X(1) Me.[LEmsD] = X(2) Me.[LEmsKh] = X(3) Me.[LDraeb] = X(4) End If واليك تعديل على مثالك بهديه اخى واستاذى جعفر جزاه الله خيرا Private Sub ITEM_BARCODE_AfterUpdate() a = DLookup("[SELLS_PRICE]& '|' & [item_name]", "POS_MASTER", "[ITEM_BARCODE]=forms!forms_1!ITEM_BARCODE") If IsNull(a) Then a = (" | ") X = Split(a, "|") Me.SELLS_PRICE = X(0) Me.ITEM_NAME = X(1) Else X = Split(a, "|") Me.SELLS_PRICE = X(0) Me.ITEM_NAME = X(1) End If End Sub وفى انتظار تعقيب اخى واستاذى العزيز جعفر تقبلوا تحياتى وتمنياتى لكم وللجميع بالتوفيق test_102.rar

ما شاء الله جميل

بالانتظار استاذي شكرا لك

السلام عليكم يمكن عمل ذلك بسهوله من خلال دالة Between بالاستعلام تحياتي انتظرني قليلا

حياك الله 🙂 انا قمت بعمل شرح اكثر في مثال الرابط ، فرجاء مراجعته ، واخبرني اذا اصبح واضح 🙂 جعفر

وعليكم السلام-تفضل hours1.xls

شكرا أخي سليم حاصبيا الملف ممتاز وساعدني لعملي جزاك الله خيرا

السلام عليكم اخوي احمد 🙂 أنا قد اجبت على سؤال الموضوع ، واخبرتك 🙂 فرجاء فتح موضوع جديد والاشارة الى هذا السؤال ، ورجاء تجاوب فيه على الاسئلة اللي طرحتها عليك (لأنك لم تجاوب عليها) ، حتى يعرف الاعضاء كيف يمكنهم مساعدتك 🙂 جعفر

جرب هذه المعادلة =EDATE($A$1,$A$2)

تفضل تم وضع المعادلة في العمود E وتتم الفلترة من خلال هذا العمود =IF(AND(ISBLANK(B2);ISBLANK(C2));"إخفاء الصف";"") Filtering.xlsx

وعليكم السلام ورحمة الله وبركاته =DATE(YEAR(A1);MONTH(A1)+B2;DAY(A1)) =DATE(YEAR(A1);MONTH(A1)+3;DAY(A1)) معادلتين : إما كتابة الرقم المضاف أو تعيين خلية لإضافة الرقم للشهر المعادلة تؤدي الغرض ويمكن للأساتذة أضافة نستفيد منها Month+3.xlsx

جرب هذا الملف My_Book.xlsm

تحية طيبة وعطرة... تفضل ما طلبته في الملف المرفق... بن علية حاجي Cash at Banks (TEST).xlsm

لم أفهم سؤالك جيداَ يمكنك الذهاب الى اي خلية رقم عامودها اكبر من 3 هناك طريقة ثانية بحماية الصفحة مع عدم السماح بالتحرير في هذه الثلاثة أعمدة مثلاً Sub Protct_Three_columns() With Sheets("ورقة1") .Unprotect .ScrollArea = "" .Cells.Locked = False .Range("A3:c3").EntireColumn.Locked = True .Protect End With End Sub

تفضل اخي حسب مافهمت من طلبك اتمنى يكون المطلوب MM-2.rar

لقد وضعت ملفاً بهذا الموضوع قبل ان ترفع مثالك ارجو ان يكون المطلوب الكود Option Explicit Sub Copy_By_Choise() Rem Created By Salim Hasbays On 1/3/2020 Application.ScreenUpdating = False On Error GoTo End_Me Dim S As Worksheet, T As Worksheet Dim i%, col%, X%, Last%, m%, k%, Howmay_row% Dim Title_arr Set S = Sheets("Source"): Set T = Sheets("Target") col = T.Cells(2, Columns.Count).End(1).Column If col = 1 Then col = 500 Howmay_row = S.Range("G2") Title_arr = Application.Transpose(S.Range("a1:d1")) Title_arr = Application.Transpose(Title_arr) Last = S.Cells(Rows.Count, 2).End(3).Row T.Range("A2").Resize(Last, col).Clear m = 3: k = 1 For i = 2 To Last For X = 0 To 3 T.Cells(m, k).Offset(, X) = _ S.Cells(i, 1).Offset(, X) Next X m = m + 1 If m Mod (Howmay_row + 3) = 0 Then m = 3: k = k + 5 Next i col = T.Cells(3, Columns.Count).End(1).Column For k = 1 To col Step 5 Cells(2, k).Resize(, 4) = Title_arr With T.Range("B2").Offset(, k - 1).CurrentRegion .Interior.ColorIndex = 6 .Borders.LineStyle = 1 .InsertIndent 1 End With Next Erase Title_arr: Set S = Nothing: Set T = Nothing End_Me: Application.ScreenUpdating = True End Sub الملف مرفق Split_table.xlsm

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

السلام عليكم ورحمة الله جرب المرفق لعل فيه ما تريد... يمكن عمل ذلك بدالة مستحدثة عن طريق VBA (والذي هو ليس من امكانياتي)... بن علية حاجي فصل أيام الغياب.xlsx

شيت مستر ملاك 2020 للمرحلة الإبتدائية شيت كنترول كامل لكل الصفوف من الأول الى السادس الابتدائى على أحدث التعليمات الواردة من الوزارة حسب قرار 311 الصادر فى 28 / 11 / 2019 و الخاص بتعديل مادة التربية الرياضية يحتوى على : 1- البيانات الاساسية 2- كشوف مناداة التلاميذ 3- لاصقات أرقام الجلوس 4- أرقام الجلوس مع جدول الامتحانات 5- قوائم الفصول 6- كشوف درجات المواد و الانشطة 7- شيت متكامل 8- نتيجة شاملة 9- احصاء 10- احصاء الجودة 11- الشهادات تقديرات فقط و تقديرات و درجات معاً 12- العشرة الأوائل 13- شهادات تقدير للأوائل يتميز بــ : سهولة التعامل صغر الحجم شامل كل المعلومات المطلوبة فى الامتحانات طباعة سريعة لكل صفحات الشيت بضغطة واحدة امكانية الترتيب الأبجدى بضغطة واحدة مع قبول أى اقتراحات جديدة كلمة المرور : 333 التحميل : http://www.mediafire.com/file/0dhgmo0446n5bwy/%D8%B4%D9%8A%D8%AA_%D9%85%D8%B3%D8%AA%D8%B1_%D9%85%D9%84%D8%A7%D9%83_2020_%D9%84%D9%84%D9%85%D8%B1%D8%AD%D9%84%D8%A9_%D8%A7%D9%84%D8%A5%D8%A8%D8%AA%D8%AF%D8%A7%D8%A6%D9%8A%D8%A9_20-1-2020.rar/file

تفضل لقد قمت بتصميم صفحة html و أرفقتها مع المثال ضعهما في نفس المجلد و جرب مع العلم أنني ما زلت لم أضع درس الأحداث بعد Desktop.rar

الحلقة الخامسة: التعامل مع الجداول في صفحة ويب سوف نتطرق في هذه الحلقة إلى الأكواد التي تمكننا من التحكم في الجداول داخل صفحة ويب و سوف نستخدم مرفق أخي ابو البشر في هذا الدرس و هي عبارة عن صفحة ويب محفوظة خاصية id للجدول اسمها: ctl00_PlaceHolderMain_gvCourseSectionExamsGrades عند فتح المرفق يجب تحديد صفحة الويب المرفقة كمصدر للأداة و ذلك بإتباع الخطوات التالية: 1- كود استخراج عدد الخلايا في الجدول: MsgBox Me.WebBrowser3.Document.getElementById("ctl00_PlaceHolderMain_gvCourseSectionExamsGrades").cells.Length 2- كود استخراج عدد الصفوف في الجدول: MsgBox Me.WebBrowser3.Document.getElementById("ctl00_PlaceHolderMain_gvCourseSectionExamsGrades").rows.Length 3- كود استخراج بيانات العمود الأول في الجدول: في هذا الكود نقوم بعرض الأرقام الموجودة في العمود الأول For i = 2 To Me.WebBrowser3.Document.getElementById("ctl00_PlaceHolderMain_gvCourseSectionExamsGrades").rows.Length MsgBox Me.WebBrowser3.Document.getElementById("ctl00_PlaceHolderMain_gvCourseSectionExamsGrades").rows(i - 1).cells(0).innerText Next i 4- كود استخراج بيانات العمود الثاني في الجدول: في هذا الكود نقوم بعرض الأسماء الموجودة في العمود الثاني For i = 2 To Me.WebBrowser3.Document.getElementById("ctl00_PlaceHolderMain_gvCourseSectionExamsGrades").rows.Length MsgBox Me.WebBrowser3.Document.getElementById("ctl00_PlaceHolderMain_gvCourseSectionExamsGrades").rows(i - 1).cells(1).innerText Next i 5- كود ارسال بيانات إلى الجدول: في هذا الكود سوف نرسل بيانات للعمود الرابع الخاص بمادة البحوث و المشروعات For i = 2 To Me.WebBrowser3.Document.getElementById("ctl00_PlaceHolderMain_gvCourseSectionExamsGrades").rows.Length Me.WebBrowser3.Document.getElementById("ctl00_PlaceHolderMain_gvCourseSectionExamsGrades").rows(i - 1).cells(3).innerText = i - 1 Next i و هذا هو المرفق به جميع الدوال. webbroser.rar

الحلقة الرابعة: التعامل مع القائمة المنسدلة في صفحة ويب سوف نتطرق في هذه الحلقة إلى الأكواد التي تمكننا من التحكم الكامل في القائمة المنسدلة داخل الأداة في صفحة ويب لقد قمت بتطبيق هذا الدرس على موقع الفايس بوك لأن به قائمة منسدلة الخاصة بالأشهر و لها خاصية: Id=month لهذه القائمة عمودين عمود مخفي و هو يمثل القيمة الحقيقة به أرقام من 0 إلى 12 و عمود ظاهر به أسماء الأشهر 1- كود حساب عدد عناصر القائمة: MsgBox Me.WebBrowser3.Document.getElementById("month").Length 2- كود معرفة القيمة الحقيقية للعنصر: من المعلوم أن القائمة المنسدلة يمكن أن يكون بها أكثر من عمود يعني ممكن تصبح القيمة الظاهرة تختلف عن القيمة الحقيقية MsgBox Me.WebBrowser3.Document.getElementById("month").Value 3- كود استخراج ترتيب القيمة الظاهرة: استخراج ترتيب القيمة الظاهر ضمن عناصر القائمة المنسدلة MsgBox Me.WebBrowser3.Document.getElementById("month").selectedIndex 4- كود استخراج القيمة الظاهرة: MsgBox Me.WebBrowser3.Document.getElementById("month").Item(Me.WebBrowser3.Document.getElementById("month").selectedIndex).innerText 5- إظهار جميع عناصر القائمة: Dim x As String Dim i As Integer For i = 1 To Me.WebBrowser3.Document.getElementById("month").Length x = x & " - " & Me.WebBrowser3.Document.getElementById("month").Item(i - 1).innerText Next i MsgBox x 6- اختيار عنصر من القائمة باستخدام رقمه الترتيبي: هنا وضعت القيمة تساوي 5 معناه سوف يتم اختيار العنصر رقم 5 و هو مايو Me.WebBrowser3.Document.getElementById("month").selectedIndex = 5 7- تغيير نص قيمة في العمود الظاهر من القائمة: سوف يتم تغيير كتابة أفريل في القائمة إلى أوفيسنا Me.WebBrowser3.Document.getElementById("month").Item(4).innerText = "أوفيسنا" 8-تغيير قيمة في العمود المخفي من القائمة: Me.WebBrowser3.Document.getElementById("month").Item(4).Value = "15" قبل البداية في تطبيق درس اليوم اضغط على زر فتح صفحة الفايس بوك لتظهر الصفحة أمامك webbroser.rar

الحلقة الثالثة: التعامل مع كائنات صفحات HTML و إرسال و إستقبال البيانات سوف نتطرق في هذه الحلقة إلى الأكواد التي تمكننا من التعامل مع كائنات صفحات الويب و إرسال و إستقبال البيانات منها و إليها. هنالك ثلاث كائنات سوف نتعامل معها فيما يخص إرسال و إستقبال البيانات و هي مربع نص و القائمة المنسدلة و الجداول لأن لكل كائن أكواده الخاصة. لكن قبل البدئ يجب التطرق إلى كيفية إستخراج الاسم المميز للعناصر ID أو NAME من أجل التعامل معها من خلال نموذج الأكسس. هناك عناصر لها ID و أخرى لها NAME و هناك لها الخاصيتين معا و هناك عناصر ليس لها NAME أو ID خطوات استخراج ID أو NAME موجود في هذه الصور: 1- كود إرسال قيمة لمربع نص في صفحة ويب: في هذا المثال سوف نستخدم صفحة غوغل و نقوم بإرسال كلمة أوفيسنا إلى من مربع بحث غوغل Me.WebBrowser3.Document.all("q").Value = "أوفيسنا" أو Me.WebBrowser3.Document.all("q").innerText = "أوفيسنا" أو Me.WebBrowser3.Document.Forms(0).q.Value = "أوفيسنا" أو Me.WebBrowser3.Document.getElementById("q").innerText = "أوفيسنا" Document : هي كل محتويات الأداة الموجوة في صفحة الويب من أزرار و مربعات و نصوص ...... 2- كود إستقبال قيمة من مربع نص في صفحة ويب: سوف نقوم باستخراج القيمة المكتوبة في مربع نص البحث لموقع غوغل MsgBox Me.WebBrowser3.Document.all("q").Value أو MsgBox Me.WebBrowser3.Document.all("q").innerText أو MsgBox Me.WebBrowser3.Document.Forms(0).q.Value أو MsgBox Me.WebBrowser3.Document.getElementById("q").innerText 3- كود الضغط على زر أمر: سوف نقوم بإرسال نقرة على زر فتح شاشة الدخول لجمايل Me.WebBrowser3.Document.Forms(0).gb_70.Click أو Me.WebBrowser3.Document.all("gb_70").Click أو Me.WebBrowser3.Document.getElementById("gb_70").InvokeMember ("Click") webbroser.rar ماذا تقصد بتنزيل البيانات ؟ هل استخراج قيم أم تنزيل ملفات

الحلقة الثانية: أكواد الطباعة و الخصائص و... سوف نتطرق في هذه الحلقة إلى الأكواد التي تمكننا من طباعة صفحة الويب و حفظها و عرض خصائص الصفحة و غيرها... 1- كود طباعة الصفحة: Me.WebBrowser3.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DODEFAULT 2- كود معاينة طباعة الصفحة: Me.WebBrowser3.ExecWB OLECMDID_PRINTPREVIEW, OLECMDEXECOPT_DODEFAULT 3- كود عرض خصائص الصفحة: Me.WebBrowser3.ExecWB OLECMDID_PROPERTIES, OLECMDEXECOPT_DODEFAULT 4- كود حفظ صفحة الويب: Me.WebBrowser3.ExecWB OLECMDID_SAVEAS, OLECMDEXECOPT_DODEFAULT 5- كود تنسيق الصفحة: Me.WebBrowser3.ExecWB OLECMDID_PAGESETUP, OLECMDEXECOPT_DODEFAULT 6- كود عنوان رابط الصفحة: MsgBox Me.WebBrowser3.LocationName 7- كود رابط الصفحة: MsgBox Me.WebBrowser3.LocationURL 8- كود فتح الصفحة الإفتراضية للمتصفح: Me.WebBrowser3.GoHome 9- كود فتح صفحة البحث: Me.WebBrowser3.GoSearch 10- كود فتح صندوق التصفح: هذا الكود يقوم بفتح صندوق لإدخال رابط صفحة ويب جديدة Me.WebBrowser3.ExecWB OLECMDID_OPEN, OLECMDEXECOPT_DODEFAULT 11- كود تخطي رسائل الأخطاء التي تظهر من الأداة عند التصفح: Me.WebBrowser3.Silent = True وهذا المرفق بعد الإضافات الجديدة webbroser.rar

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

أبدأ بحمد الله أولا وأخيرا على ما انعم ووفق وأصلي واسلم على الرحمة المهداة والسراج المنير نبينا محمد وعلى آله وصحبه وسلم ... وبعد في أحدي الموضوعات علي منتدانا الكريم وفي موضوع لاحد الأخوة بطلب برنامج ليتمكن من ادارة الأشتراكات الشهرية (اشتراكات DSL - كروت - توزيع شبكات انترنت او شبكات الكابل التلفزيوني ) وما الي ذلك من الاشتراكات التي تحتاج لمتابعة شهرية علي انتهاء صلاحية اسم المستخدم مثلا او متابعة حركة السداد المختلفة لذلك وفقني الله سبحانه وتعالي لتلك الفكرة بعمل برنامج يقوم بمتابعة تلك الاشتراكات الشهرية ومتابعة سداد وعمل وطباعة تقارير عن المديونية والمبيعات وكشف حساب للعميل وما الي ذلك من العمليات التي يمكن ان يحتاجها المستخدم لادارتها وكذلك ادخال اغلبية البيانات تلقائيا كرقم ايصال السداد مسلسل العميل تاريخ نهاية الاشتراك وادعو الله سبحانه وتعالي ان اكون وفقت في البرنامج وان يكون فيه النفع ويمكن تطويع البرنامج ليتلائم مع ادارة المشروعات الفردية الصغيرة ايضا ولا تنسونا من دعوة صالحة في ظهر الغيب بصلاح الحال ناتي لشرح بعض خصائص البرنامج المختلفة أترككم لتجربة البرنامج في المرفقات وارحب بمشاركتكم في اجراء اية تعديلات وفقنا الله واياكم للصالحات مع تحياتي // ضاحي الغريب Manage Subscriptions By Dahy al Gharieb.rar

السلام عليكم أخي محمد انا لن اتطرق لطريقة عمل النموذج الجديد ، "لأننا" لم نلحظ المشكلة في النموذج الاصل ولكني دخلت في كود Combopn_AfterUpdate : pn = DLookup("pn", "code", "[pn]=forms!frm_dataentry!Combopn") size = DLookup("Size", "code", "[pn]=forms!frm_dataentry!Combopn") vendor = DLookup("Vendor", "code", "[pn]=forms!frm_dataentry!Combopn") Description = DLookup("Description", "code", "[pn]=forms!frm_dataentry!Combopn") Maxrl = DLookup("Maxrl", "code", "[pn]=forms!frm_dataentry!Combopn") Maxrlegyptair = DLookup("Maxrlegyptair", "code", "[pn]=forms!frm_dataentry!Combopn") ACType = DLookup("actype", "code", "[pn]=forms!frm_dataentry!Combopn") Pos = DLookup("pos", "code", "[pn]=forms!frm_dataentry!Combopn") BiasRadial = DLookup("biasradial", "code", "[pn]=forms!frm_dataentry!Combopn") code = DLookup("code", "code", "[pn]=forms!frm_dataentry!Combopn") لاحظت انك تنادي الجدول (اي تعمل استعلام للجدول) 10 مرات !! انا دائما لما اعمل برامجي ، اعمل البرنامج على اساس انه سيكون عبارة عن جزئين ، الواجهة FE ، والجداول BE ، وان الجداول BE ، ستكون في شبكة ، وان الواجهة FE ستكون لأكثر من مستخدم. لهذا السبب ، فيجب ان نقلل الزحمة في الشبكة ، وذلك بتقليل زيارة/استعلام الجداول قدر الإمكان ، وعند كل زيارة ، يجب ان نأخذ اكبر كمية من البيانات المطلوبة ، ثم نتعامل معها محليا في FE. لذلك ، فانا هنا اعطيك احد البدائل (والتي لا يعرفها الكثير ، لأنها تعمل على الاكسس 2003 فما فوق) ، فالكود التالي ، يقوم بزيارة/استعلام الجدول عن طريق DLookup مرة واحدة ، ويأخذ 10 بيانات مرة واحدة ، فلذا يمكن ان يستبدل كودك اعلاه: Dim x() As String A = Nz(DLookup("[pn] & '|' & [Size] & '|' & [Vendor] & '|' & [Description] & '|' & [Maxrl] & '|' & [Maxrlegyptair] & '|' & [actype] & '|' & [pos] & '|' & [biasradial] & '|' & [code]", "code", "[pn]=forms!frm_dataentry!Combopn"),"|||||||||") 'ويمكن استعمال اي شيء بدل عن | فمثلا الفاصلة 'A حتى اذا لم هناك قيمة للمتغير Nz نستعمل الدالة 'عدد مرات وضع العلامة | في نهاية السطر ، يكون نفس عددها في المعادلة 'لهذا السبب نرى اننا وضعنا 9 منها في نهاية السطر x = Split(A, "|") ' For i = LBound(x) To UBound(x) ' Debug.Print x(i) ' Next i Me.pn = x(0) Me.size = x(1) Me.vendor = x(2) Me.Description = x(3) Me.Maxrl = x(4) Me.Maxrlegyptair = x(5) Me.ACType = x(6) Me.Pos = x(7) Me.BiasRadial = x(8) Me.code = x(9) جعفر

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

الأستاذ / وائل البسطي السلام عليكم ورحمة الله وبركاته إليك الملف به المطلوب. الرقم القومي.rar

السلام عليكم الكود التالي يعمل على 2003-2007 Option Explicit '////////////////////////////////////////////////////// ' اسم مجلد الملفات Const FilName As String = "ملفاتي" ' عنوان خلية الجمع في الملفات Const Adr As String = "A1" '////////////////////////////////////////////////////// Sub kh_SumAllBook() Dim MyObj, MyObjFol, Obj Dim xlw As Excel.Workbook Dim MySheet As Worksheet Dim iPath As String, iName As String Dim Last As Long, i As Long Dim ch As String * 1 ch = Application.PathSeparator '============================ On Error GoTo Err_kh_Files '============================ iPath = ActiveWorkbook.Path & ch & FilName & ch Set MyObj = CreateObject("Scripting.FileSystemObject") Set MyObjFol = MyObj.GetFolder(iPath) '============================ Set MySheet = ThisWorkbook.Worksheets("TOTAL") '============================ With MySheet Last = .Cells(Rows.Count, "A").End(xlUp).Row .Range("A2").Resize(Last, 3).ClearContents End With '============================ kh_Application False '============================ On Error Resume Next For Each Obj In MyObjFol.Files iName = Obj.Path If Not Dir(Obj.Path) = "" Then If TestType(CStr(Obj.Name)) Then Set xlw = Workbooks.Open(iName) With MySheet i = i + 1 .Cells(i + 1, "A").Value = CStr(Obj.Name) .Cells(i + 1, "B").Value = CStr(xlw.Worksheets(1).Name) .Cells(i + 1, "C").Value = Val(xlw.Worksheets(1).Range(Adr)) End With xlw.Close False End If End If Next On Error GoTo 0 '============================ If i Then MySheet.Range("E2").Value = Evaluate("Sum(" & Range("C2").Resize(i).Address & ")") '============================ Err_kh_Files: kh_Application True If Err Then MsgBox "Err.Number:" & vbCr & Err.Number: Err.Clear '============================ Set MySheet = Nothing: Set MyObj = Nothing: Set MyObjFol = Nothing End Sub Sub kh_Application(mbol As Boolean) With Application .Calculation = IIf(mbol, -4105, -4135) .ScreenUpdating = mbol .EnableEvents = mbol End With End Sub Function TestType(MyTName As String) As Boolean Dim MyTyp As String MyTyp = Mid$(MyTName, InStrRev(MyTName, ".")) TestType = MyTyp Like ".xls*" End Function المرفق 2003-2007 kh_sum.rar

اخي والله الكود عندي يعمل بشكل طبيعي لكن جرب التالي ـ 1 ) كون مجلد و سمه RR و ضع فيه ملغات شرط ان تكتب في الخلية A1 من كل ملف قيمة معينة ـ 2 ) انشأ مجلدا آخر و ضع فيه المجلد السابق ـ 3 ) انشأ ملف اكسل ثم افتحه ـ 4 ) اذهب الى محرر VB ثم اضف موديل و انسخ فيه الموديل التالي : Declare Function SearchTreeForFile Lib "IMAGEHLP.DLL" _ (ByVal lpRootPath As String, _ ByVal lpInputName As String, _ ByVal lpOutputName As String) As Long Public Const MAX_PATH = 260 Public Function FindFile(RootPath As String, _ FileName As String) As String Dim lNullPos As Long Dim lResult As Long Dim sBuffer As String On Error GoTo FileFind_Error sBuffer = Space(MAX_PATH * 2) lResult = SearchTreeForFile(RootPath, FileName, sBuffer) If lResult Then lNullPos = InStr(sBuffer, vbNullChar) If Not lNullPos Then sBuffer = Left(sBuffer, lNullPos - 1) End If FindFile = sBuffer Else FindFile = vbNullString End If Exit Function FileFind_Error: FindFile = vbNullString End Function ـ 5 ) اذهب الى صفحة Workbook و افتحها و انسخ الكود الاتالي في الحدث Workbook_Open الكود : Private Sub Workbook_Open() ورقة1.Range("A1:A50").ClearContents Set Files = Application.FileSearch With Files .LookIn = ThisWorkbook.Path + "\RR" .FileName = "*.xls" If .Execute > 0 Then For i = 1 To .FoundFiles.Count ورقة1.Cells(i + 1, 1) = .FoundFiles(i) Next i Else MsgBox "لا يوجد ملفات في المسار" & vbNewLine & ThisWorkbook.Path + "\F", vbInformation, "خطأ" End If End With End Sub ـ 6 ) أنشأ في الصفحة الاولى من الملف زر و قم بنسخ الكود التالي في هذا الزر : Private Sub CommandButton1_Click() LastRow = Cells(Rows.Count, "D").End(xlUp).Row '+ 1 On Error Resume Next Dim xl As New Excel.Application Dim xlw As Excel.Workbook Dim Vr As String Vr = ThisWorkbook.Path & "\RR" For n = 1 To 10 Set xlw = xl.Workbooks.Open(Cells(n + 1, 1)) xlw.ورقة1.Range("A1").Select Cells(LastRow + n, 4).Value = xlw.Application.Range("A1").Value xlw.Close False Next LR = Cells(Rows.Count, "D").End(xlUp).Row For t = 1 To LastRow s = LR Cells(1, 5).Formula = "=Sum(D1:D" & s & ")" Next End Sub الآن احفظ الملف في المجلد الثاني الذي أنشأته و اخرج منه ثم اعد فتحه من جديد فإن وجدت في الصفحة الاولى اسماء الملفات التي وضعتها في المجلد RR فالعمل صحيح ما بقي الا الضغط على الزر و ان لم تجد . . . . . . . فالله اعلم بالخطأ الذي وقع