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

اكتب الايام اقل من عشر وكذلك الاشهر بصيغة 01 حتى رقم 09 لكي لا تحصل على نتيجة غير صحيحة مثل تاريخ 1/1/2020 اكتب في يوم 01 وشهر 01 الخ او دع دالة format وغير الكود للشكل التالي [يوم]&"/"&[شهر]&"/"&[سنة] او اعكس الموضوع فيكون ادخال تاريخ الميلاد وتحصل على اليوم والشهر والسنة عن طريق الحقل المحسوب لليوم Day([المواليد1]) للشهر Month([المواليد1]) للسنة Year([المواليد1])

السلام عليكم 🙂 1. رجاء انزل البرنامج المرفق ، ثم انسخ الكائنين منه الى برنامجك الرئيسي ، واحذف البرنامج المرفق ، ثم العمل على نسخة من برنامجك الاصلي ، 2. تأكد ان جميع النماذج مغلقه ، ثم افتح النموذج zfrm_Testing ، وانقر على الزر . 3. هذا سيعمل مجلدات في مجلد برنامجك ، وفي كل مجلد المرفقات التي به (حسب ID سجل برنامجك) ، وسيقوم بتصدير جميع مرفقاتك الى المجلدات : . 4. لما ينتهي البرنامج من تصدير الملفات ، سيعطيك رسالة Done ، 5. افتح النموذج Masttr Form2 ، وسترى المرفقات موجودة على يمين الشاشة (انظر للصورة في الاسفل) ، 6. المرفقات في الاعلى تابعة للنموذج الرئيسي ، والمرفقات في الاسفل تابعة للنموذج الفرعي (رجاء التاكد ان المرفقات صحيحة ، وهي نفسها الموجودة في برنامجك) : . انا لم اقم بعمل كود لحذف اي شيء من برنامجك ، اذا اردت ان تضيف مرفق جديد ، فتستطيع ان تمسكه من متصفح الملفات ، وتفلته Drag and Drop سواء في المجلد العلوي او السفلي ، البرنامج تلقائيا يضيف المجلدات. بعد ان تتأكد ان البرنامج يعمل بطريقة صحيحة ، تستطيع يدويا ان تحذف حقول المرفقات من جدوليك ، ثم استعمل ضغط واصلاح 🙂 هذا هو الكود الموجود في النموذج zfrm_Testing ، والذي يصدر المرفقات الى مجلدات و ملفات خارجية : Private Sub cmd_Export_Attachments_Click() On Error GoTo err_cmd_Export_Attachments_Click Dim rst_tbl As DAO.Recordset Dim rst_Att As DAO.Recordset Dim myDir As String Dim File_Name As String 'table name : [Mastr Table] 'Attachment filed name : [مرفقات] Set rst_tbl = CurrentDb.OpenRecordset("Select * From [Mastr Table]") While Not rst_tbl.EOF ' Loop through the table 'check if the Dir exists, if not, make it myDir = Application.CurrentProject.Path & "\Attachments" 'Attachments Call Make_Dir(myDir) myDir = myDir & "\Mastr_Table" 'Mastr_Table Call Make_Dir(myDir) ' myDir = myDir & "\" & rst_tbl![CUSTOMER COD] 'Customer_Code ' Call Make_Dir(myDir) myDir = myDir & "\" & rst_tbl!ID 'ID Call Make_Dir(myDir) Set rst_Att = rst_tbl.Fields("[مرفقات]").Value While Not rst_Att.EOF ' Loop through the attachments. ' File_Name = myDir & "\" & rst_tbl!ID & "_" & rst_Att.Fields("Filename") 'ID and Attachment names ' rst_Att.Fields("FileData").SaveToFile File_Name ' Save current attachment rst_Att.Fields("FileData").SaveToFile myDir rst_Att.MoveNext Wend 'rst_Att rst_tbl.MoveNext Wend 'rst_tbl '' ' '[Payment Table] '[مرفقات] Set rst_tbl = CurrentDb.OpenRecordset("Select * From [Payment Table]") While Not rst_tbl.EOF ' Loop through the table 'check if the Dir exists, if not, make it myDir = Application.CurrentProject.Path & "\Attachments" 'Attachments Call Make_Dir(myDir) myDir = myDir & "\Payment_Table" 'Mastr_Table Call Make_Dir(myDir) ' myDir = myDir & "\" & rst_tbl![CUSTOMER COD] 'Customer_Code ' Call Make_Dir(myDir) myDir = myDir & "\" & rst_tbl!ID 'ID Call Make_Dir(myDir) Set rst_Att = rst_tbl.Fields("[مرفقات]").Value While Not rst_Att.EOF ' Loop through the attachments. ' File_Name = myDir & "\" & rst_tbl!ID & "_" & rst_Att.Fields("Filename") 'ID and Attachment names ' rst_Att.Fields("FileData").SaveToFile File_Name ' Save current attachment rst_Att.Fields("FileData").SaveToFile myDir rst_Att.MoveNext Wend 'rst_Att rst_tbl.MoveNext Wend 'rst_tbl rst_tbl.Close: Set rst_tbl = Nothing rst_Att.Close: Set rst_Att = Nothing Exit_cmd_Export_Attachments_Click: MsgBox "Done" Exit Sub err_cmd_Export_Attachments_Click: If Err.Number = 3420 Then 'ignore rst not there Resume Next ElseIf Err.Number = 3839 Then 'file exists Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub Public Function Make_Dir(Dir_Name As String) As Boolean 'Make_Dir = True ' a new Directory was made 'Make_Dir = False ' the Directory Exists 'check if the Dir exists, if not, make it If Dir(Dir_Name, vbDirectory) = "" Then MkDir Dir_Name Make_Dir = True ' a new Directory was made End If End Function . وهذا كود لحدث الحالي والذي يُظهر المرفقات في كائن webbrowser في النموذج Masttr Form2 : Dim myDir As String 'Mastr_Table, Dir exists, if not, make it myDir = Application.CurrentProject.Path & "\Attachments" 'Attachments Call Form_zfrm_Testing.Make_Dir(myDir) myDir = myDir & "\Mastr_Table" 'Mastr_Table Call Form_zfrm_Testing.Make_Dir(myDir) myDir = myDir & "\" & Me!ID 'ID Call Form_zfrm_Testing.Make_Dir(myDir) 'Payment_Table, Dir exists, if not, make it myDir = Application.CurrentProject.Path & "\Attachments" 'Attachments Call Form_zfrm_Testing.Make_Dir(myDir) myDir = myDir & "\Payment_Table" 'Payment_Table Call Form_zfrm_Testing.Make_Dir(myDir) myDir = myDir & "\" & Me!ID 'ID Call Form_zfrm_Testing.Make_Dir(myDir) 'specify that the browser is an object in the Form Set web = Me.objIE.Object Set web_2 = Me.objIE_2.Object 'Master, Open/Navigate the page myDir = Application.CurrentProject.Path & "\Attachments" 'Attachments myDir = myDir & "\Mastr_Table" 'Mastr_Table myDir = myDir & "\" & Me!ID web.Navigate myDir 'Payment, Open/Navigate the page myDir = Application.CurrentProject.Path & "\Attachments" 'Attachments myDir = myDir & "\Payment_Table" 'Mastr_Table myDir = myDir & "\" & Me!ID web_2.Navigate myDir جعفر 1195.zip

استخدم دالة format واجعل عملية الاحتساب في النموذج او الاستعلام الملف مرفق الكود في حدث بعد التحديث لحقل سنة نصيحة استخدم تسمية الحقول باللغة الانجليزية New Microsoft Access قاعدة بيانات (2).accdb

تفضل 1- حدد بالماوس انطاق "C3:P3" 2- نفذ الكود 3- اختيار yes 4- الملفات المصدرة بصيغة txt ستحفظ في مجلد الملف الرئيسي Enquiry.rar

تم معالجة الامر الصفحة Salim من هذا الملف Order_Lycee_1 - Copy.xlsm

وعليكم السلام .. جرب كده وقولى .. عملت تعديلات على جداول وعلاقات وطبقتلك الفكرة المطلوبة فى النموذج Database2.accdb

بعد اذن استاذنا سليم , ولإثراء الموضوع يمكنك وضع هذه الأكواد فى حدث الصفحة Dim mRg As Range Dim mStr As String Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Range("A2:D1000"), Target) Is Nothing Then Set mRg = Target.Item(1) mStr = mRg.Value End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim xRg As Range On Error Resume Next Set xRg = Intersect(Range("A2:D1000"), Target) If xRg Is Nothing Then Exit Sub Target.Worksheet.Unprotect Password:="123" If xRg.Value <> mStr Then xRg.Locked = True Target.Worksheet.Protect Password:="123" End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Range("A2:D1000"), Target) Is Nothing Then Set mRg = Target.Item(1) mStr = mRg.Value End If End Sub

تم التعديل جرب واخبرنا مثال (1).rar

بعد اذن الاخ سليم تجربة لحل باستخدام دالة اخرى Test2.xlsx

هذا الكود ربما يساعدك Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim a, b, c a = Not Intersect(Target, Union(Range("A2:A1000"), _ Range("D2:D1000"))) Is Nothing b = Target.Cells(1) <> vbNullString c = Target.Count = 1 Application.EnableEvents = False If a * b * c <> 0 Then Target.Offset(, 1).Select End If Application.EnableEvents = True End Sub

فورم اكسل بحث عن اسم الصحابى وصفته ونبذه عنه الفيديو الملفات كود البحث فى رجال حول الرسول.pdf بحث فى رجال حول الرسول.xlsm

جزاك الله خيرا اخى واستاذى @kha9009lid تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق

ماشاء الله ولا قوه الا بالله بارك الله فيك وجزاك الله خيرا اخى واستاذى ومعلمنا الغالى @jjafferr ربنا يجعله فى موازين حسناتك تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق

اتفضل اخى @ازهر عبد العزيز ان شاء الله يكون ما طلبت Me.RecordSource = "SELECT microbiology.* FROM microbiology WHERE (((Val([genome]))>50) AND ((microbiology.microtype)='large'));" بالتوفيق ان شاء الله

بارك الله فيك اخ سليم الملف يعمل 10/10

الطريقة هنا

وعليكم السلام ورحمة الله وبركاته تفضل Database2.accdb

السلام عليكم النموذج المرسل فارغ لايوجد به لا شيت ولا غيره

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

ربما كلمت شكر لاتكفي ولكن مع دعوة بالغيب .......ربي يحفظك

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

اتفضل اخى @ازهر عبد العزيز ولا يهمك وربنا يديم المعروف اخى تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق micro(2)(1).accdb

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

السلام عليكم تفضل أخي الملف المرفق ترحيل على رقم الفوج.xlsm

ولكني اريد ان ارجع الى مقترحي السابق : واليك التفاصيل من واقع تجربتي مع اطباء الاسنان ، وكلامنا عند النقر المزدوج على الضرس ، وبها يتم ادراج سجل جديد في النموذج الفرعي : 1. سيكون لديك سجل عن رقم الضرس التي تم قلعها ، ومتى وملاحظات الدكتور ، 2. بالنسبة الى حشو الضرس (والذي هو محل نقاشنا) ، ومن تجربتي ، وبعد 5 الى 10 سنوات ، يأتي الشخص الى الدكتور وفيه وجع ، ويقوم الدكتور بالفحص ويسأل : اي ضرس تم العمل عليه سابقا ، متى تم العمل عليه ، ماهي الخطوات التي قام الدكتور بعملها (هل اكمل العمل في جلسة واحدة لسبب معين ، او اكثر من جلسة ، وماذا عمل في كل جلسة) ، من الدكتور الذي قام بالعمل ، وهل هناك ملاحظات خاصة تركها الدكتور لهذا الضرس ، هل تم ازالة العصب ، هل تم عمل حشو مؤقت من نوع معين ، على ان يرجع الشخص بعد وقت معين لجلسة اخرى لعمل حشو من نوع آخر ، متى تم تنضيف الاسنان . هذه بعض الملاحظات اللي تجي على بالي ، وبرنامجك لا يقوم بها ، بينما اذا عملت البرنامج مثل اقتراحي ، فيمكنك اضافة جميع هذه الملاحظات في النموذج الفرعي (وهو جاهز بنسبة 70-80%) ، وحذف الـ 54 كائن من Option Group والتي تزيد من ثقل النموذج !! مجرد إضافة حقل "نوع العمل" كومبوبكس ، واسم الدكتور ، والسلام 🙂 طبعا الكود سيقوم بإظهار وإخفار الضروس ، حسب "نوع العمل" 🙂 ومثل ما قلت لك سابقا : . جعفر

يحتاج وقت ،،،، في المستقبل إن شاء الله تعالى

تفضل اخي jo 🙂 بدلا عن For i = 1 To RC Select Case rst!Tooth_Number Case 11 To 48 Me("A_" & rst!Tooth_Number).Visible = False Case 51 To 85 Me("P_" & rst!Tooth_Number).Visible = False End Select rst.MoveNext Next i استعمل For i = 1 To RC Select Case rst!Tooth_Number Case 11 To 48 Me("A_" & rst!Tooth_Number).Visible = False Me("s" & rst!Tooth_Number).Visible = False Case 51 To 85 Me("P_" & rst!Tooth_Number).Visible = False Me("s" & rst!Tooth_Number).Visible = False End Select rst.MoveNext Next i . جعفر

اتفضل اخى @ازهر عبد العزيز ان شاء الله يكون ما طلبت تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق micro(2).accdb

معادلا ت ممتازة لكن في هذه الحالة لا بد من ادراج معادلة مستقلة لكل عامود من العامود (R) الى العامود (AC) بينما في اجابتي معادلة في الخلية (R6) واحدة تكفي مع سحبها يسارا 12 عامود و نزولاً 6 صفوف (بدون عامود مساعد)

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

جرب هذا المرفق الكود يعمل في حدث الشيت "change" Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim rng, lr lr = Cells(Rows.Count, "c").End(3).Row Set rng = Range("c5:c" & lr) If Not Intersect(Target, rng) Is Nothing Then If Not IsDate(Target) = True Then Target = "" Else Target = Format(Target, "dd-mm-yyyy") Target.Offset(, 1) = Format(DateAdd("yyyy", 2, Target), "dd-mm-yyyy") Exit Sub End If End If End Sub Increment (1).xlsm

جرب هذا الماكرو Option Explicit Sub ALL_in_one_cells() Dim ro, st$, i% ro = Cells(Rows.Count, 1).End(3).Row For i = 1 To ro If Cells(i, 1) <> vbNullString Then st = st & Cells(i, 1) & "," End If Next st = Mid(st, 1, Len(st) - 1) & "." Cells(3, 4) = st Cells(3, 4).Columns.AutoFit End Sub الملف مرفق One_for_All.xlsm

تفضل أخي أكتب فقط تاريخ البدء و الساعة في الخلية C7 . و اكسل يقوم بالباقي. يمكنك سحب المعادلات الى الاسفل لمزيد من اسماء المداومين. جدول المداومة.xlsx

بالخدمة اخي العزيز وسنتواصل عند عودتك بالسلامة

مطلوب دالة او طريقة لتقسيم الرقم القومى كما فى الملف المرفق الى 14 خلية تقسيم الرقم.rar

نعم يوجد .. خاصة قواعد بيانات mdb ابحث عند السيد google تجد ..

السلام عليكم ورحمة الله وبركاته يا استاذ محمد سلامة الف تحية لك انا نزلت القاعدة ... وحسب فهمي للموظوع عو يريد ان يعمل له برامج لفتح قاعدة بيانات محمية مع تقدير

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

السلام عليكم ورحمة الله محاولة أخرى باستعمال الدالة MOD (وفي بعض الحالات مع الدالة RIGHT) والنتيجة تعطي أرقاما وليس text ... أنظر المرفق... تقسيم الرقم.rar

أخى انظر المرفق تقسيم الرقم.rar

السلام عليكم تفضل أخي الملف المرفق به ما تطلب تقسيم الرقم.rar