نجوم المشاركات
Popular Content
Showing content with the highest reputation on 03 ينا, 2020 in all areas
-
بسم الله الرحمان الرحيم و الصلاة و السلام على أشرف المرسلين أما بعد: سوف نقوم اليوم إن شاء الله بشرح أداة 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.rar6 points
-
الحل الاسهل نقوم بنسخ الجدول الموجود به السجلات المكررة نقوم بلصقة في نفس القاعدة ومن الاختيارات التي سوف تظهر لنا نختار البنية فقط نقوم بالدخول على خصائص الجدول الجديد في خانة الاسم في حالتناونجعلة مفتاح اساس لايقبل التكرار نقوم بعمل استعلام الحاق لكافة البيانات نقوم بتشغيل الاستعلام ونتجاهل ايرسالة خطأ بعد انتهاء تنفيذ الاستعلام سوف نجد انالاسماء المكرر حذفت من الجدول الجديد نقوم بحذف البيانات من الجدول القديم ونستبدلها بالبيانات الغير مكررة ويمكن تنفيذ ذلك يدويا او باستعلام دائما وابدا نحتفظ بنسخة احتياطية قبل تنفيذ ماسبق رتبت لك الخطوات للتسهيل مع الشكر لاخي احمد على جهوده3 points
-
جرب المرفق Database751.accdb هههههه اخي احمد نفس الفكرة بعد التحديث للحقل [نص0] = Format([نص0], "00/00/0000")3 points
-
انتظرت ردك اخي الكريم فان كنت تقصد تحديد الاسم الاول في القائمة عن الضغط على الزر فاليك الامر التالي Me.txtliste3.Selected(0) = True تحياتي3 points
-
جرب هذا الكود Option Explicit Sub give_data() Dim ARR_P, P As Worksheet, D As Worksheet Dim MY_RG As Range, MY_NAME$, R%, i% ARR_P = Array(4, 6, 9, 2, 16, 15, 17, 13, 14, 7, 8, 3, 18, 19) Set P = Sheets("Principal"): Set D = Sheets("DATA") P.Cells(7, "C").Resize(14) = vbNullString MY_NAME = P.Range("A3") Set MY_RG = D.Range("B3").CurrentRegion If MY_RG.Columns("E").Find(MY_NAME, lookat:=1) Is Nothing Then Exit Sub R = MY_RG.Columns("E").Find(MY_NAME, lookat:=1).Row For i = 0 To UBound(ARR_P) P.Cells(7, "C").Offset(i).Value = D.Cells(R, ARR_P(i)) Next Erase ARR_P End Sub الملف مرفق Data_base.xlsm3 points
-
تفضل اخي الكريم تم انشاء استعلام من داخل الفورم وبناءا على الاستعلام يتم خروج التقرير المطلوب بناءا على طلبك برنامج غيابات وحضور الطلاب الالكتروني بواسطة الباركود.rar3 points
-
الشكر لله ثم لاخواننا واساتذتنا وبلاش كلمه سيدى خليها اخى افضل فكلنا اخوان فالله ممكن تحوله ل 2003 وتشتغل عليه ثم تستورد الجدول بعد ما تخلص شغلك وان شاء الله احد اساتذتنا يوفرلك حلول اخرى تقبل تحياتى وتمنياتى لك بالتوفيق وممكن تجرب الحل اللذى فالرابط الذى اشار لك به اخى خالد بالاعلى وهو من استاذنا الجليل ابو خليل2 points
-
2 points
-
الشكر لله اولا ثم لاخواننا واساتذتنا جزاهم الله خيرا عنا بالاضافه الى ما ذكره اخى ابو البشر - يجب عليك مراعاه وضع عنوان مناسب للموضوع مثلا كيفيه حذف اسماء مكرره سؤال هل لهذه الاسماء كود مميز ام لا ؟ حتى يسهل عليك الفرز والحذف لان وجود مسافات زائده او تشابك لن يعتبر تشابه فالاسماء تقبل تحياتى درس حذف السجلات المكررة من الجدول اسهل طريقة - بدون استعلامات.rar2 points
-
اخي @rey360 اذا كان فهمي لطلبك صحيح فان الاستاذ محمد اعطاك حل صحيح جرب الملف المرفق test(5).accdb2 points
-
وعليكم السلام ورحمه الله وبركاته مجرد فكره اجعله حقل نصى عادى ثم عند الخروج من الحقل او حدث بعد التحديث استخدم الخاصيه format فى محرر الاكواد لجلعه بتنسيق التاريخ تقبل تحياتى2 points
-
السلام عليكم اخي صالح 🙂 شو اللي جاب هذا الموضوع على بالك بعد حوالي سنتين جعفر2 points
-
2 points
-
السلام عليكم أستاذ أحمد الفلاحجى ما اسم الكتاب؟ أما بنسبة للاستاذ عبد الفتاح كيرة فهذا الموقع يعطيك الكثير من الكتب بالانجليزية أرجو أن ينفعك https://b-ok.cc/s/sql2 points
-
2 points
-
السلام عليكم جرب المرفق لعل فيه ما تريد بعد تعديل طفيف على كود الأخ حسين مامون... TEST_2.xls2 points
-
الاخوة اعضاء المنتدى العظيم بمناسبة تجديد المنتدى بثوبه الجديد نتعرف على موضوع الدوال بطريقة بسيطة تكملة لموضوع كيفية تصميم شيت بالاكسل الذى تم تنفيذه سابقا ارجو ان ينال رضاكم الدوال الدوال هى أوامر تقوم بتنفيذ مهام معينة وتتم كتابتها داخل الخلايا المختلفة لورقة العمل ويمكن تقسيم الدوال الى ست مجموعات كما يلى 1 الدوال العامة 2 الدوال المالية 3 الدوال الرياضية 4 الدوال الحرفية 5 الدوال الخاصة بالتاريخ والوقت 6 دوال قاعدة البيانات تعال معا نتعرف على كيفية البحث عن الدوال المختلفة الموجودة بالاكسل كيفية استخراج الدالة.rar2 points
-
الحل استبدل الماكروات الى هذه Option Explicit Sub Edit_data() Dim Source_rg As Range Dim Find_rg As Range Dim r# Union(Range("b8:l8"), Range("c9:l9")).ClearContents Dim lra#: lra = Me.Cells(Rows.Count, 1).End(3).Row Set Source_rg = Me.Range("a12:M" & lra) Set Find_rg = Source_rg.Find(Me.Range("D6"), Lookat:=1) If Find_rg Is Nothing Then MsgBox "'This Number Does't Exists" Exit Sub End If r = Source_rg.Find(Me.Range("d6")).Row With Me.Range("b8") .Value = Cells(r, 2): .Offset(, 1) = Cells(r, 3): .Offset(, 2) = Cells(r, 4) .Offset(, 3) = Cells(r, 5): .Offset(, 4) = Cells(r, 6): .Offset(, 5) = Cells(r, 7) .Offset(, 6) = Cells(r, 8): .Offset(, 7) = Cells(r, 9): .Offset(, 8) = Cells(r, 10) .Offset(, 9) = Cells(r, 11): .Offset(, 10) = Cells(r, 12) .Offset(1, 1) = Cells(r, 13) End With End Sub '+++++++++++++++++++++++++++++++++++++++++++ Sub ADD_data() Dim Source_rg As Range Dim Find_rg As Range Dim r# Dim lra#: lra = Me.Cells(Rows.Count, 1).End(3).Row Set Source_rg = Me.Range("a12:M" & lra) Set Find_rg = Source_rg.Find(Me.Range("d2"), Lookat:=1) If Find_rg Is Nothing Then MsgBox "'This Number Does't Exists" Exit Sub End If r = Find_rg.Row '======================================== With Me.Range("b4") Cells(r, 2) = .Value: Cells(r, 3) = .Offset(, 1): Cells(r, 4) = .Offset(, 2) Cells(r, 5) = .Offset(, 3): Cells(r, 6) = .Offset(, 4): Cells(r, 7) = .Offset(, 5) Cells(r, 8) = .Offset(, 6): Cells(r, 9) = .Offset(, 7): Cells(r, 10) = .Offset(, 8) Cells(r, 11) = .Offset(, 9): Cells(r, 12) = .Offset(, 10): Cells(r, 13) = .Offset(1, 1) End With End Sub '++++++++++++++++++++++++++++++++++++++++++++++++ Sub Ta3dil() Dim Source_rg As Range Dim Find_rg As Range Dim r# Union(Range("B4:L4"), Range("C5:L5")).ClearContents Dim lra#: lra = Me.Cells(Rows.Count, 1).End(3).Row Set Source_rg = Me.Range("a12:M" & lra) Set Find_rg = Source_rg.Find(Me.Range("D2"), Lookat:=1) If Find_rg Is Nothing Then MsgBox "'This Number Does't Exists" Exit Sub End If r = Source_rg.Find(Me.Range("D2")).Row With Me.Range("b4") .Value = Cells(r, 2): .Offset(, 1) = Cells(r, 3): .Offset(, 2) = Cells(r, 4) .Offset(, 3) = Cells(r, 5): .Offset(, 4) = Cells(r, 6): .Offset(, 5) = Cells(r, 7) .Offset(, 6) = Cells(r, 8): .Offset(, 7) = Cells(r, 9): .Offset(, 8) = Cells(r, 10) .Offset(, 9) = Cells(r, 11): .Offset(, 10) = Cells(r, 12) .Offset(1, 1) = Cells(r, 13) End With End Sub اضافة عبارة LookAt:=1 الى كل العبارات التي تحتوي على Set Find_rg الملف من جديد T-2019_Salim_new.xlsm2 points
-
السلام عليكم و رحمة الله تعالى وبركاته إخوتي الكرام حياكم الله. بعد نزع خاصية انشاء شريط القوائم بالأكسس في النسخ بعد 2003 أصبح هناك عائق كبير في إضافة هذه الأشرطة و لأنه يتوجب عليك العمل على ملف 2003 أو استعمال Ribbon بلغة Html و هي أصعب من الفكرة الأولى. مما جعلني أفكر في طريقة تجعلنا نستغني عن هذه الطرق المرهقة بعض الشيء. و قمت بتصميم برنامج يستطيع أن يضيف شريط قوائم للنموذج الرئيسي لقاعدة البيانات مهما كانت نسختها 2003 أو النسخ التي تأتي بعدها. نبدأ على بركة الله في شرح البرنامج: بعد فتح البرنامج نتبع الخطوات التالية: 1 - أكتب اسم القوائم التي تريد أن تضيفها مع وضع رقم كل قائمة بالترتيب (1,2,3,....و هكذا) 2- أضف العناصر أو الأوامر التي تندرج تحت كل قائمة في النموذج الفرعي رقم العنصر , تسمية العنصر ثم الكود الذي تريد أن ينفذه هذا العنصر 3- أختر قاعدة البيانات سواءا كانت 2003 أو ما بعدها ثم اختر اسم النموذج الذي تريد أن تضيف له الشريط 4- قم بالضغط على زر "إنشاء الشريط" 5- افتح قاعدة بياناتك و أنظر للشريط المضاف حتى لو كان النموذج منبثق و شاشة الأكسس مخفية سوف ترى الشريط شروط استخدام البرنامج: 1- قبل البدئ أحفظ نسخة إحتياطية من قاعدة بيانات 2- يجب أن لا يكون لديك في قاعدة بيانات نماذج بهذه الأسماء : list1,list2,list3..... و هكذا 3- يجب أن يكون حدث عن النقر للنموذج الرئيسي خال من أي كود 4-بعد الإنتهاء أدعولي و لوالدي و لعائلة بالخير و الصلاح. هذا هو البرنامج انشاء شريط قوائم.rar1 point
-
جرب المرفق DoCmd.RunSQL "DELETE * FROM table1 WHERE key NOT IN ( SELECT min(key) FROM table1 GROUP BY FirstName, Address2)" حذف السجلات المكررة.mdb1 point
-
جزاك الله خيرا اخى واستاذى جعفر جزاك الله خيرا اخى ابو البشر تقبلوا تحياتى وتمنياتى لكم وللجميع بالتوفيق1 point
-
جربي المرفق Test1.accdb DoCmd.SetWarnings False If [خيار12] = True Then DoCmd.RunSQL "UPDATE table1 SET table1.yesno = yes " Me.Requery Else DoCmd.RunSQL "UPDATE table1 SET table1.yesno = no " Me.Requery End If DoCmd.SetWarnings True1 point
-
1 point
-
اتفضلى محاوله منى على قدى بس عملتها عن طريق زر اضفت زرين واحد لوضع العلامه وواحد للالغاء بالتوفيق yn.accdb1 point
-
جرب الان STOCK.accdb باقي التقارير اجعلها منبثق نعم مشروط نعم ثم في امر فتح التقرير اضف امر تكبير1 point
-
وده مثال اخر لحذف مش اخفاء انتبه تحدد فيه الجدول والحقل المراد وتنفذ وبه ملف شرح فيديو + رابط تقبل تحياتى وبالتوفيق برنامج لحذف الحقول المكرره ببرنامجك مفتوح المصدر.rar1 point
-
1 point
-
1 point
-
1 point
-
وعليكم السلام 🙂 نعم يمكن ، وتفتح نموذج معين ، وتعمل له تصفية ، وللقراءة فقط 🙂 يعني تعمل فيه اللي تريد 🙂 اقتطعت هذا الكود من احد برامجي : Private Sub cmd_View_Kids_info_Click() On Error GoTo err_cmd_View_Kids_info_Click Dim appAccess As Object Dim DB_Path As String Dim myWhere As String 'if the Remote Application/Form is open, close it first appAccess.DoCmd.Quit 'now open the Form for the new Employee_ID Set appAccess = CreateObject("Access.Application") DB_Path = "\\Managing_1\h\Personal\FE\Personal_FE.accdb" appAccess.OpenCurrentDatabase (DB_Path) myWhere = "[Full_Name]='" & Me.frm_1_All!Full_Name & "'" myWhere = myWhere & " And [Relation]<>'زوجة'" myWhere = myWhere & " And [Relation]<>'زوج'" appAccess.DoCmd.OpenForm "sfrm_Family", , , myWhere, acFormReadOnly appAccess.Visible = True appAccess.UserControl = True 'Set appAccess = Nothing Exit_cmd_View_Kids_info_Click: Exit Sub err_cmd_View_Kids_info_Click: If Err.Number = 91 Or Err.Number = 462 Then 'the application is NOT open, ignore the error Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر1 point
-
السلام عليكم 🙂 اليك هذا المرفق ، فيه مثالين: المثال الاول: عندنا جدولين ، tbl_Seq و tbl_New_Seq ، فيهم نفس البيانات ، نريد نأخذ اكبر قيمة من الحقل Seq في tbl_Seq ، ثم نستخدم هذه القيمة ، وندخل بقية البيانات في الجدول tbl_New_Seq ، المثال الثاني: نفس المثال الاول ، ولكن العمل على جدول واحد فقط ، tbl_Sections . المشكلة في لما تستعمل استعلام المجاميع ، والامر Max للحقل Seq ، لتحصل على اعلى قيمة ، ثم تربطه بالجدول الآخر ، فيصبح استعلامك (نموذجك) غير قابل للتعديل ، بينما اذا استعملنا نفس استعلام المجاميع اعلاه ، بالامر Max للحقل Seq ، ولكن استعملناه كإستعلام فرعي ، فيصبح الاستعلام (النموذج) قابل للتعديل 🙂 اترك لك المجال تفحص المثال الاول ونتائجه ، وهنا اوضح عمل المثال الثاني: فنرى اني عملت استعلام فرعي للقيمة Seq : . ونتيجة الاستعلام ، يمكن تعديلها ، للحقل New_Section : . وللتجربة ، اخذ الاستعلام الفرعي اعلاه ، وضعه في استعلام مستقل ، ثم اربط الاستعلام بالجدول ، فلن تحصل على نتيجة صحيحة !! جعفر 1167.SubQuery.mdb.zip1 point
-
شكرا لك أستاذ kha9009lid وشكرا للاستاذ محمد ابوعبد الله على كل ماقمتم به أرجو أن يكون في ميزان حسناتكم test(5).accdb1 point
-
عند اخفاء نوافذ اكسس حول جميع النماذج والتقارير الى منبثق ومشروط وسوف تعمل ان شاء الله1 point
-
1 point
-
1 point
-
استاذنا الفاضل يبدو انك نسيت ارفاق الملف في انتظارة للتعلم والاستفاذة شكرا على ارفاق الملف1 point
-
جرب هذا الكود تم تغيير اسماء الشيتات الى اللغة الاجنبية لسهولة التعامل مع الكود من حيث النسخ واللصق Option Explicit Private Sub Worksheet_Activate() FIL_CDATA_VAL End Sub '++++++++++++++++++++++++++++++++++++++++++++++++ Sub FIL_CDATA_VAL() Dim i As Long: i = 8 Dim DIC As Object Set DIC = CreateObject("Scripting.Dictionary") Do Until Sheets("DATA").Range("C" & i) = vbNullString DIC(Sheets("DATA").Range("C" & i).Value) = "" i = i + 1 Loop With Sheets("RESULT").Range("k5").Validation .Delete .Add 3, Formula1:=Join(DIC.KEYS, ",") End With Set DIC = Nothing End Sub '++++++++++++++++++++++++++++++++++++++++ Sub GET_CERTIFICAT() Dim dat As Worksheet, RES As Worksheet Dim Num%, k%, R, i%, Found_Ro%, Ro%: Ro = 8 Dim FOUND_RG As Range Dim n: n = 3 Dim arr Set dat = Sheets("DATA"): Set RES = Sheets("RESULT") Union(RES.Range("c5"), RES.Range("c19"), RES.Range("c33")) = vbNullString Union(RES.Range("c8:k9"), RES.Range("c22:k23"), RES.Range("c36:k37")) = vbNullString Num = RES.Range("K5") arr = Array(2, 5, 7, 9, 11, 13, 15, 17, 19, 21) For k = 1 To n Set FOUND_RG = dat.Range("a8").CurrentRegion.Columns(3). _ Find(Num, LOOKAT:=1) If FOUND_RG Is Nothing Then Exit Sub R = FOUND_RG.Row RES.Cells(Ro - 3, 3) = dat.Cells(R, arr(0)) For i = 1 To UBound(arr) With RES.Cells(Ro, 3).Offset(, i - 1) .Value = dat.Cells(R, arr(i)) .Offset(1) = dat.Cells(R, arr(i) + 1) End With Next RES.Cells(Ro + 2, 3) = dat.Cells(R, 23) Num = Num + 1: Ro = Ro + 14 Next End Sub الملف مرفق RESULT.xlsm1 point
-
وعليكم السلام ورحمة الله وبركاته اخي الكريم للبحقث بالاسم استخدم الكود التالي mySQL = "Select * From Clients" 'بحث nomComplet mySQL = mySQL & " WHERE nomComplet = '" & Me.Texte2.Value & "'" Me.txtliste3.RowSource = mySQL Me.txtliste3.Requery للبحث بالرقم استخدم الكود التالي mySQL = "Select * From Clients" 'بحث idClient mySQL = mySQL & " WHERE idClient = " & Me.Texte2.Value Me.txtliste3.RowSource = mySQL Me.txtliste3.Requery test(5).rar تحياتي1 point
-
عليكم السلام جرب المرفق فيه كود انشاء مجلد في :D وهذا ان لم يجده اسم المجلد myDOSER ويحول المدى المحدد في الكود الى PDF TEST .xls1 point
-
1 point
-
1 point
-
1 point
-
1 point
-
1 point
-
أقسم بالله لسة فاتح النت حالاً ...☺️ خالص شكري وتقديري للجميع أستاذ عبد الله أنا عاجز عن الشكر تسلم أيدك ويارب دايماً بالصحة والخير والسعادة1 point
-
1 point
-
1 point
-
1 point
-
1 point
-
السلام عليكم ورحمة الله محاولة في الملف المرفق... بن علية حاجي المثال.xls1 point