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

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

استخدم هذا الكود ....... Dim strDirectoryPath As String strDirectoryPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & "sample" If Dir(strDirectoryPath, vbDirectory) = "" Then MkDir strDirectoryPath Output_Path = CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & "sample" & "\" & Format(Date, "dd-mm-yyyy") & ".xlsx" DoCmd.OutputTo acOutputQuery, "q1", "ExcelWorkbook(*.xlsx)", Output_Path, False, "", , acExportQualityPrint MsgBox "تمت عملية انشاء المجلد باسم Sample بنجاح مع تصدير الملف", vbInformation, " مبروك "

وهذه مشاركة مع دكتورنا الغالي ...... ( طريقة أخرى عن طريق الاستعلام ربما اسرع عندما تكون البيانات او السجلات كثيرة ) transport (3).accdb

استخدم قاعدة IF لاني اكتب على الموبايل تفضل <<<<<<>>>>>> Private Sub السيارة_جاهزة_Click() If Me.السيارة_جاهزة = True Then Me.السيارة_مغادرة = False ElseIf Me.السيارة_مغادرة = True Then Me.السيارة_جاهزة = False End If End Sub Private Sub السيارة_مغادرة_Click() If Me.السيارة_مغادرة = True Then Me.السيارة_جاهزة = False ElseIf Me.السيارة_جاهزة = True Then Me.السيارة_مغادرة = False End If End Sub مثال نعم لا.accdb

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

الف مبروك و الي الامام دائما باذن الله 🌼

بارك الله فيك حبيبنا ... وثناءك العاطر ....

تفضل >>>>> warehouse3.accdb

تفضل جرب >>>>>>>> warehouse31.accdb

هذا يفعله الكود تماما ... عند محاولة اسناد المخزن ١ مثلا ل kanory ... وكان هذا المخزن مؤجر لeng.qassim تظهر رسالة تخبرة بانه سبق تاجير المخزن ... والافضل من هذا كله .. عند تاجير المخزن١ مثلا يختفى في الكمبوبكس ولا يظهر ابدا الا بعد الاخلاء ... لكن طلب السائل ذلك واجبته بارك الله فيك وننتظر جواب السائل ...

جرب هذا الكود في حدث بعد التحديث للكمبو بكس Dim a As String a = "renting" If DCount("[Customer_Name]", "Customer", "[warehouse A] ='" & Me![Combo69] & "' AND [status] ='" & a & "'") > 0 Then Cancel = True MsgBox "هذا المخزن تم استأجاره", vbCritical, "عملية خاطئة" ElseIf DCount("[Customer_Name]", "Customer", "[warehouse B] ='" & Me![Combo69] & "' AND [status] ='" & a & "'") > 0 Then Cancel = True MsgBox "هذا المخزن تم استأجاره", vbCritical, "عملية خاطئة" ElseIf DCount("[Customer_Name]", "Customer", "[warehouse C] ='" & Me![Combo69] & "' AND [status] ='" & a & "'") > 0 Then Cancel = True MsgBox "هذا المخزن تم استأجاره", vbCritical, "عملية خاطئة" ElseIf DCount("[Customer_Name]", "Customer", "[warehouse D] ='" & Me![Combo69] & "' AND [status] ='" & a & "'") > 0 Then Cancel = True MsgBox "هذا المخزن تم استأجاره", vbCritical, "عملية خاطئة" ElseIf DCount("[Customer_Name]", "Customer", "[warehouse E] ='" & Me![Combo69] & "' AND [status] ='" & a & "'") > 0 Then Cancel = True MsgBox "هذا المخزن تم استأجاره", vbCritical, "عملية خاطئة" End If

الحمد لله رب العالمين .... بالتوفيق

طيب جرب المرفق التالي ..... YasEnEx2021_Kanory.rar

هل هذا التصور المطلوب حتى يتم العمل عليه ؟؟؟؟؟

وعليكم السلام بس واضح من الجدول ان الموظف 10002 مسجل دخول1 في كل ايام الشهر ............................ هل هذا يعني ان بقية الموظفين غياب .؟؟؟؟؟

يمكنك استعمال هذه المعادلة في الخلية F3 =INDEX($H$3:$H$7,MATCH(E3,$G$3:$G$7,0)) مع نسخ المعادلة لأسفل بالتوفيق

تفضل <<<<<<>>>>>> b2.accdb

اشكرك اخي الكريم كل المحبة والاحترام

ماشاء الله اسال الله ان يبارك لك

يمكنك استعمال هذا الكود في حدث عند التغيير في شيت سعد ولمن لا يعرف كيفية إضافة الكود في أحداث الصفحة كلك يمين على اسم الشيت ونختار view code بالعربي عرض التعليمات البرمجية ثم نلصق الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$F$5" Then Sheet24.Range("b10:i1000").ClearContents For r = 3 To Sheet14.Cells(Rows.Count, 2).End(3).Row If Sheet14.Range("n" & r) = Target Then lr = Sheet24.Cells(Rows.Count, 2).End(3).Row + 1 cols = Array(3, 2, 9, 10, 11, 5, 14, 15) For n = 2 To 9 Sheet24.Cells(lr, n) = Sheet14.Cells(r, cols(n - 2)) Next n: End If: Next r MsgBox "Done by mr-mas.com" End If End Sub بالتوفيق

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

كل الشكر التقدير لك استاذي

استاذى ومعلمنا / @Barna والله انت استاذ وعبقرى الله يفتح عليك ويزيدك من علمه هو المطلوب كل الاحترام والتقدير

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

🙄🤔 بالتوفيق

ممتاز استاذ محمد

Mr. Mohamed's solution is simpler and better but this is my try using VBA in worksheet module Private Sub Worksheet_Change(ByVal Target As Range) Dim x, r If Target.CountLarge > 1 Then Exit Sub Application.EnableEvents = False With Sheets(2) If Target.Address = "$E$5" Then If IsEmpty(Target) Then Target.Offset(, 1).ClearContents x = Application.Match(Target.Offset(, -1), .Rows(1), 0) r = Application.Match(Target.Value, .Columns(x), 0) If Not IsError(x) And Not IsError(r) Then Target.Offset(, 1).Value = .Cells(r, x).Offset(, 1).Value End If End With Application.EnableEvents = True End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim x, c As Long, sList As String If Target.CountLarge > 1 Then Exit Sub Application.EnableEvents = False With Sheets(2) If Target.Address = "$D$5" Then For c = 1 To 53 Step 2 sList = sList & IIf(sList = Empty, Empty, ",") & .Cells(1, c).Value Next c With Target.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="" & sList End With Target.Offset(, 1).Resize(1, 2).ClearContents ElseIf Target.Address = "$E$5" Then If IsEmpty(Target.Offset(, -1)) Then Target = Empty Else If Target = Empty Then x = Application.Match(Target.Offset(, -1), .Rows(1), 0) If Not IsError(x) Then Target.Validation.Delete Target.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & .Name & "!" & .Range(.Cells(2, x), .Cells(.Cells(Rows.Count, x).End(xlUp).Row, x)).Address End If End If End If End If End With Application.EnableEvents = True End Sub

عليكم السلام و رحمة الله وبركاته إن شاء اللّه يكون هذا هو المطلوب تم استعمال أربعة أعمدة مساعدة في جلب البيانات حتى تعمل دوال البحث بدقة بالتوفيق اسعار الشحن.xlsx

Thank you everybody. It is my honor to be one of the forum members

اوه رائع! تهانينا على الترقية! هذا يعني فقط أن عملك يلمس القلوب. على أي حال ، أتمنى أن تنجح في المستقبل. بارك الله.

إذا كنت تقصد كود زر الإضافة لا يتم الترحيل إلى. B2 وإنما إلى B50 وذلك بسبب قراءتك لآخر صف في sheet2 باسمها الكودي والتي تشير إلى شيت final والصواب Last = ورقة3.Range("B304").End(xlUp).Row + 1 بالتوفيق

وعليكم السلام ورحمة الله وبركاته يمكنك استخدام استعلام الحاق لتفيذ الجزء الاول DoCmd.SetWarnings False DoCmd.OpenQuery "Query1" DoCmd.SetWarnings True وللجزء الثاني استخدم الكود التالي Me.NO.SetFocus Me.NO = "" بيانات الموظفين.accdb تحياتي

شكرا جزيلا

ممتاز فعلا افضل حل و بإحترافية تامة

يبدو أن حضرتك ما قرأت هذا السطر يعني بعد تنفيذ الإجراء نذهب إلى الخلية K11 ستجد بها المعادلة بصورتها الطبيعية المعروفة التي يمكن فهما بصورة عادية أرجو أن يكون الأمر اتضح وتم تفسير الغموض وإذا كنت تريد قراءتها بالصورة العادية في الكود يمكنك تغيير سطر المعادلة .FormulaR1C1 بهذا السطر .Formula = "=IF(COUNT($J11:J11)=0,IF(IF(AND(IF(K$2="""",TRUE,$C11=K$2),IF(K$3="""",TRUE,$D11=K$3),IF(K$4="""",TRUE,$E11=K$4),IF(K$5="""",TRUE,$F11=K$5),IF(K$6="""",TRUE,$G11=K$6),IF(K$7="""",TRUE,$H11=K$7)),COUNT(K$10:K10)+1,"""")>K$9,"""",IF(AND(IF(K$2="""",TRUE,$C11=K$2),IF(K$3="""",TRUE,$D11=K$3),IF(K$4="""",TRUE,$E11=K$4),IF(K$5="""",TRUE,$F11=K$5),IF(K$6="""",TRUE,$G11=K$6),IF(K$7="""",TRUE,$H11=K$7)),COUNT(K$10:K10)+1,"""")),"""")" وهي نفسها المعادلة الموجودة في K11 بالتوفيق

واياك أخي ابا الحسن ...... بالتوفيق ...

طبعا هذا الكلام في حالة مخزن واحد .... لاتستطيع اخفائها في حالة اكثر من مخزن افتح الاستعلام qry_Items_Dates_2 في حالة التصميم ثم طبق الصورة ,,,,,,

تفضل اسم التقرير Report1 تم التجميع على حسب المنطقة و المجموعة transport.accdb

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

عندما يرى رواد المنتدى هذه العلامة تعني انه نم الاجابة والوصول لافضل اجابة ...... وهذه العلامة من حق من يجيب احابة وافية وليس هي للسائل نفسه ؟؟؟؟؟؟

وهذا الإصدار الأحدث من اللعبة في موقعي الشخصي https://www.mr-mas.com/p/guess-numbers-game.html وفقنا الله جميعا لكل خير

شكرا لمروركم الكريم

هذه بالكود Private Function ID_Val(ByVal SEGEL_NO As String) As Boolean On Error Resume Next Dim i, TOT, ten As Integer Dim TEMP, FIN As String TOT = 0 For i = 1 To 9 If i Mod 2 <> 0 Then TEMP = (CInt(Mid(SEGEL_NO, i, 1)) * 2) If Len(TEMP) = 1 Then TEMP = "0" & (CInt(Mid(SEGEL_NO, i, 1)) * 2) Else TEMP = (CInt(Mid(SEGEL_NO, i, 1)) * 2) End If TOT = TOT + CInt(Mid(TEMP, 1, 1)) + CInt(Mid(TEMP, 2, 1)) Else TOT = TOT + CInt(Mid(SEGEL_NO, i, 1)) End If Next FIN = Format(TOT, "00") ten = CInt(Mid(SEGEL_NO, 10, 1)) ID_Val = (CInt(Mid(FIN, 2, 1)) = ten) Or (ten = 10 - CInt(Mid(FIN, 2, 1))) End Function الخوارزمية باختصار نضرب الأعداد الفردية من رقم السجل المدني بـ 2 ثم نجمع الآحاد مع العشرات ونضيف معهم مجموع الأعداد الزوجية وفي النهاية يكون معنا عدد مكون من آحاد وعشرات فإذا تشابه الآحاد مع آخر رقم من السجل المدني فهو صحيح أو ننقص 10 من آحاد الناتج فإذا تشابه مع آخر رقم من السجل المدني فهو صحيح

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

بانتظارك أخي الكريم

شكرا لك أخي ياسر يسّر الله أحوالك مجموعة رائعة من المواقع تسلم مفضلتك وبانتظار باقي الإخوة

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

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

سعيد بمرورك أخي محمد طاهر وجاري برمجة مفضلة بال php كما اقترحت حضرتك وسيتم الإعلان عنها عند الانتهاء وبعد التجربة بانتظار مشاركات الإخوة

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