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

السلام عليكم ورحمة الله وبركاته ، أخواني وأساتذتي ومعلمينا ( دون استثناء ) 📌 أقدم لكم اليوم فكرة قد تكون ليست بالجديدة ، ولكنها بالحديثة و بطريقة فوكشية ▫▪◽◾◻◼. الكثير من المواضيع التي تحدثت عن كيفية رفع ملفات المستخدم على جوجل درايف أو غيره من المواقع التي تقدم مساحات سحابية متعددة الخدمات لمستخدميها .. اليوم وبتوفيق من الله ، تم إنشاء هذه الأداة للتعامل مع جوجل درايف Google Driveحصراً ، لكونه يقدم مساحة 15 جيجا بايت لمستخدميه . ما كان يؤرق الكثيرين هو أن جوجل أو غيره من مقدمي الخدمة المشابهة يقوم بتعديل سياسته وقوانينه كل فترة . لكن هنا وبهذه الأداة المجانية تم حل المشكلة بعد فحصها مراراً وتكراراً (متمنياً ذلك) . الفكرة في الأداة تعتمد على حساب جوجل أو Gmail شخصي . ما يلزم المستخدم هنا تطبيق الخطوات البسيطة التالية حسب الصور أو الفيديو في هذا الرابط . 📌 عند فتح الأداة لأول مرة ، سيساعدك معالج الإنشاء بجميع الخطوات ( خطوة بخطوة ) وستظهر لك هذه الرسالة :- 📌 عند النقر على Yes ، ستظهر لك رسالة الإرشاد الأولى كالتالي :- 📌 سيتم فتح المتصفح لديك على الرابط الخاص بإنشاء الخدمة .. وللمتابعة دون الإطالة ، أترككم مع الصور و الخطوات خطوة بخطوة . 📌 عند الإنتهاء من تنفيذ الخطوات والحصول على رمزي الـ ( CLIENT ID و CLIENT SECRET ) . ✨ سيتوجه بك معالج الإنشاء للخطوة قبل الأخيرة كالآتي :- 📌 هنا يطلب منك لصق رمز CLIENT ID الذي حصلت عليه من تسلسل الخطوات السابقة . ثم بعد لصقه والضغط على OK ، ستظهر لك الرسالة التالية :- 📌 والتي يطلب منك لصق CLIENT SECRET كما في الصورة أعلاه . ✨ الآن الخطوة الهامة والتلقائية ، وبعد لصق الرمزين الخاصين بحسابك في جوجل درايف ( لا تقم بمشاركتهم مع أي أحد ) ، سنهب للحصول على رمز التفويض مرة واحدة فقط ! وهذا يعني أنك لن تحتاج إليه مستقبلاً . انظر الصورة التالية :- 📌 عند النقر على موافق ، سيتم فتح متصفحك على رابط خاص في جوجل لتمنح بريدك الإلكتروني الذي استخدمته في إنشاء الخدمة سابقاً كامل الصلاحية لإستخدام خدمات جوجل درايف . وطبعاً بالمتابعة وتأكيد الموافقة ، ستحصل على رمز التفويض الخاص بك و لمرة واحدة فقط ولن تحتاجه فيما بعد ، فتقوم بنسخه ولصقه في رسالة التأكيد التالية :- الآن وبفضل الله ، ستظهر لك رسالة " تم التفويض بنجاح" ، وبهذه الخطوة تم ربط آكسيس بحساب جوجل درايف الخاص بك ، وستظهر لك واجهة الأداة كما في الصورة أدناه . وما يلي شرحاً سريعاً لمميزاتها . مميزات الأداة :- تتيح لك الأداة رفع الملفات بأي امتداد وبأي حجم ؛ إلى أي مجلد تحدده في حسابك على جوجل درايف ، أو في الملف الرئيسي عند عدم اختيارك لمجلد محدد . والمجلدات التي في حسابك ستظهر لك عند النقر على زر "مجلداتي" ، ثم من قائمة الكومبوبوكس ستختار المجلد الهدف لرفع الملف اليه . زر "إختيار ملف" لإختيار الملف الذي ترغب برفعه على جوجل درايف . زر "معاينة" مخصص لمعاينة الملف حسب الرسالة التي ستظهر لك . زر "مسح الحقول" لتفريغ العناصر من قيمها . زر "ارفع الملف" والذي من خلاله ستقوم بتنفيذ عملية رفع الملف إلى حسابك في جوجل درايف . بعد إتمام عملية الرفع بنجاح ، يتم عرض المساحة المستخدمة من المساحة التخزينية لحسابك ( وهي 15 جيجا ) ، والنسبة المئوية للمساحة في عنوان النموذج ، كما في الصورة أدناه لعملية الرفع . زر "نسخ الرابط" لنسخ الرابط بعد أن تمت عملية الرفع بنجاح ( لإستخداماتك الشخصية وحاجتك لاحقاً ) . وفيما يلي ، صورة سريعة لعملية رفع صورة على سبيل المثال : ملف الأداة بنسختين .. نسخة 64 بت نسخة 32 بت Uploader.zip Uploader 32.zip

اهلا بالشايب الخبير 🙂 ولحل هذ النقطة ، هذا الكود على حدث تحميل النموذج سيحل المشكلة (نحن قمنا باختيار سجل واحد سابقا ، فالبحث يتم لسجل واحد فقط) Private Sub Form_Load() '- Find the Checked y_n field Me.y_n.SetFocus DoCmd.FindRecord "-1", , , , , , True Me.myID = Me.id End Sub . اما النقطة الثانية ، فالمفروض ان يتم تغيير البيانات من النموذج فقط ، وإلا ، فيجب تحدبث الجدول (سيكون اسرع من تحديث آلاف السجلات في النموذج)

للكومبوبوكس في حدث بعد التحديث Me.Requery

وممكن كده برضو SELECT student.id_stu, student.name, student.saf_id, student.totale, student.galose, student.fasle, student.birth, Tbl_saf.saf_id, Tbl_saf.saf FROM student INNER JOIN Tbl_saf ON student.saf_id = Tbl_saf.saf_id WHERE student.saf_id = [Forms]![form1]![cc] AND (SELECT COUNT(*) FROM student AS s2 WHERE s2.saf_id = student.saf_id AND (s2.totale > student.totale OR (s2.totale = student.totale AND s2.birth < student.birth) OR (s2.totale = student.totale AND s2.birth = student.birth AND s2.name < student.name)) ) < 10 ORDER BY student.saf_id, student.totale DESC , student.birth, student.name;

وعليكم السلام ورحمة الله وبركاته ,, جرب هذا الاستعلام SELECT TOP 10 student.id_stu, student.name, student.saf_id, student.totale, student.galose, student.fasle, student.birth, Tbl_saf.saf_id, Tbl_saf.saf FROM student INNER JOIN Tbl_saf ON student.saf_id = Tbl_saf.saf_id WHERE student.saf_id = [Forms]![form1]![cc] ORDER BY student.totale DESC , student.birth, student.name;

السلام عليكم اجابات الشباب كانت تغير القيم في الجدول ، بينما احاول جاهدا التقليل من زيارات الجدول ، بسبب الشبكة والتقليل من الضغط على الجداول ، فيكون عملي على النموذج فقط 🙂 طريقة العمل: في النموذج اعمل حقل مخفي اسمه myID ، ثم نعمل حدثين على الحقل y_n : قبل التحديث: يتأكد انك اخترت صح ، وانك على سجل غير السجل السابق ، فعليه ، يغير قيمة الصح من السجل السابق (ID السجل موجود في myID) ، الى 0 بعد التحديث: نعطي رقم ID السجل للحقل myID Private Sub y_n_BeforeUpdate(Cancel As Integer) If Me.y_n = -1 And Me.id <> Me.myID Then '- y_n checked, and Record ID <> myID With Me.RecordsetClone .FindFirst "[ID]=" & Me.myID .Edit !y_n = 0 .Update End With End If End Sub Private Sub y_n_AfterUpdate() Me.myID = Me.id End Sub . 1622.aa.accdb.zip

وعليكم السلام ورحمة الله تعالى وبركاته جرب هل هدا ما تقصده Option Explicit Sub CreateDossiers() Dim a As Variant, lastRow As Long, i As Long Dim folderPath As String, Dossier As String, ky As String Dim nCarte As String, nEmploy As String, tyCont As String Dim ScrWS As Worksheet: Set ScrWS = Sheets("ورقة1") lastRow = ScrWS.Cells(ScrWS.Rows.Count, "b").End(xlUp).Row a = ScrWS.Range("B2:D" & lastRow).Value folderPath = ThisWorkbook.Path & "\" If Dir(folderPath, vbDirectory) = "" Then MkDir folderPath For i = 1 To UBound(a, 1) nCarte = Trim(a(i, 1)): nEmploy = Trim(a(i, 2)): tyCont = Trim(a(i, 3)) If nCarte <> "" And IsNumeric(nCarte) And nEmploy <> "" And tyCont <> "" Then Dossier = folderPath & tyCont & "\" If Dir(Dossier, vbDirectory) = "" Then MkDir Dossier ky = Dossier & nCarte & " - " & nEmploy & "\" If Dir(ky, vbDirectory) = "" Then MkDir ky End If Next i MsgBox "تم إنشاء المجلدات بنجاح", vbInformation End Sub عقود V1.xlsb

بيض الله وجهك... وجزاك خير الجزاء الكود الأخير عمل بامتياز شكرا لك

يعمل عندي 100%100 يمكن جربت ملف آخر بداله جرب الكود في حدث كليك y_n CurrentDb.Execute ("UPDATE a SET a.y_n=false") DoCmd.RunCommand acCmdSaveRecord

شكرا جزيلا استاذ @عبدالله بشير عبدالله و ايضاً الشكر للأستاذ @محمد هشام. الطريقتين صحيحتين و استفيد منهما

تفضل استاذ @فؤاد الدلوي مستخدما كود الاستاذ @ابو عارف هذا المرفق . ووافني بالرد . DDFouadTest .rar

تفضل استاذ @abofayez1 Private Sub y_n_AfterUpdate() If Me.y_n.Value = True Then Dim strSQL As String strSQL = "UPDATE a SET y_n = False WHERE ID <> " & Me.id CurrentDb.Execute strSQL, dbFailOnError Me.Requery End If End Sub aa-1.accdb

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

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

السلام عليكم مشاركة مع اخي خليفة كود لتكرار السجل في الجدول نفسه في المثال : فقط انقر نقرا مزدوجا على حقل الاسم الذي تريد تكراره DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdCopy DoCmd.RunCommand acCmdRecordsGoToNew DoCmd.RunCommand acCmdSelectRecord DoCmd.RunCommand acCmdPaste Test2.rar

واياكم اخى ولا يهمك تحت امرك طيب اتفضل جرب المرفق ده واخبرنى بالنتيجه بالتوفيق help_2.mdb

وعليكم السلام ورحمة الله تعالى وبركاته حاول دمج الأكواد السابقة في كود واحد لتتمكن من طباعة وصل معين أو عدة وصولات من إختيارك بالطريقة التالية Sub Choose_the_print() Dim tmp As Variant, arr As Variant, n As Range Dim OnRng As String, xInput As String, a(1 To 6) As String Dim WS As Worksheet: Set WS = Sheets("ورقة1") a(1) = "H2:L16": a(2) = "N2:R16": a(3) = "T2:X16": a(4) = "H18:L32": a(5) = "N18:R32": a(6) = "T18:X32" xInput = InputBox("يرجى إدخال أرقام الوصولات للطباعة" & vbCrLf & "مفصولة بفاصلة (-) مثل: 3-2-1", "إختيار الوصولات") If Trim(xInput) = "" Then: MsgBox "لم يتم إدخال أي أرقام يرجى المحاولة مرة أخرى", vbExclamation: Exit Sub tmp = Split(xInput, "-") For Each arr In tmp If IsNumeric(Trim(arr)) Then If Val(arr) >= 1 And Val(arr) <= 6 Then OnRng = a(Val(arr)) Set n = WS.Range(OnRng) n.PrintOut Copies:=1, Collate:=True Else MsgBox "رقم الوصل " & arr & " غير موجود يرجى التأكد", vbExclamation Exit Sub End If Else MsgBox "إدخال خاطئ " & arr, vbExclamation Exit Sub End If Next arr MsgBox "تمت الطباعة بنجاح", vbInformation End Sub مثال.xlsm

وعليكم السلام ورحمة الله وبركاته حسب فهمى لطلبك اليك الملف مثال (1).xlsm

السلام عليكم ابو احمد افتقدناك في منتدى الاكسس ، وفاز بك منتدى الاكسل. طرح جديد ومميز ، كالعادة ، شكرا على المشاركة. جعفر

ولا يهمك اخى ولست بمعلم ولكن انتبه فمعظمنا لديه ما يشغله ويدخل لبضع من الوقت لمحاوله مساعده اخوانه اتفضل هذا التعديل المؤقت منى ربما يضع احد اخواننا حل افضل منه او تاتينى فكره اخرى عندما يهدأ بالى مما يشغله بالتوفيق CALLQ_1.accdb

تفضل استاذ @فؤاد الدلوي حسب مافهمت تفضل المرفق بعد التعديل بطلبك والشرح . ووافني بالرد . الاقساط السنوية غير المدفوعة-1.rar

جزاك الله كل خير وأكرمك الله بالدارين

أحسنت وأحسن الله اليك .. عمل رائع جزاك الله كل خير

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

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

أحسنت أستاذ مجدى بارك الله فيك وزادك الله من فضله

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

بسيطة بعد اذن طبعاً الأستاذ ابراهيم ..عليك بإضافة هذا السطر بالكود قبل نهايته TextBox2.Text = Format(Val(TextBox2.Text), "0.0") تجريبى1.xlsm

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

وعليكم السلام-استخدم هذه المعادلة =IF($B7="مصطفي","لا يوجد","")

تفضل بسيطة يمكنك التواصل مع الأستاذ خالد صابر .مصمم البرنامج المشروح بالفيديو وسينفذ لك طلبك ان شاء الله بمقابل مادى وللتواصل معه عبر الإميل :khaledsaber2030@gmail.com واتس : 00201007630611

وعليكم السلام-تفضل لك ما طلبت trait office1.xlsm

وعليكم السلام-تفضل على الرغم انك لم تقم برفع ملف توضيحى لطلبك =LEN(A1)

تفضل

بسيطة يمكنك استخدام هذه المعادلة فقط =SUMIFS($C$4:$C$17,$F$4:$F$17,"<>"&"مسدد",$B$4:$B$17,"<"&$H$2) 6.xlsx

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

السلام عليكم مرة أخرى أحبائي الكرام أقدم لكم هذا البرنامج البسيط و نموذج حول التصفية واعطاء بنية للفورم و أيضا قاعدة البيانات الشرح كل في اكسل وتقبلو مني كل التقديرات وشكرا دمتم في رعاية الله وحفظه أخوكم مناد سفيان من الجزائر .................... fenetre_automatique Algérino.rar

نعم اتفضل تم التعديل عليه fenetre_automatique Algérino.rar

تفضل 3 طرق لتصفح الانترنت من الاكسس ، والبحث عن اسم الطالب في Google.com . وهذا كود الازرار: Private Sub cmd_FollowHyperlink_Click() url_address = "http://www.google.com/search?lr=lang_ar&cr=&hl=ar&ie=windows-1256&oe=windows-1256&q=" Application.FollowHyperlink url_address & Me!name End Sub Private Sub cmd_ie_Click() Dim ie As Object Set ie = CreateObject("internetexplorer.application") url_address = "http://www.google.com/search?lr=lang_ar&cr=&hl=ar&ie=windows-1256&oe=windows-1256&q=" ie.Visible = True ie.Navigate url_address & Me!name End Sub Private Sub cmd_objIE_Click() 'Reference to Microsfot Internet Controls 'c:\windows\system32\ieFrame.dll Dim web As WebBrowser Set web = Me.objIE.Object url_address = "http://www.google.com/search?lr=lang_ar&cr=&hl=ar&ie=windows-1256&oe=windows-1256&q=" web.Silent = True 'stop script errors web.Navigate url_address & Me!name End Sub جعفر 255.web.accdb.zip