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

السلام عليكم ورحمة الله وبركاته.. اليوم سأشرح لكم الدالة StrConv ولأي الامور تستخدم. الدالة حصرا تتعامل مع النصوص ( String ) ووضيفتها التحويل بين الاحرف الانجليزية ( كبير , صغير ) الدالة تأخذ 3 براميترات: البراميتر القيمة الوصف vbUpperCase 1 تحويل جميع الحروف الى حروف كبيرة vbLowerCase 2 تحويل جميع الحروف الى حروف صغيرة vbProperCase 3 تحويل الحرف الاول من كل كلمة الى كبير وباقي حروف الكلمة الى حروف صغيرة vbUnicode 64 تحويل النص الى سلسلة الـ UNICODE vbFromUnicode 128 تحويل النص من سلسلة UNICODE الى تنسيقات اخرى مثال: StrConv ("officena semo pa3x", 1) Result: "OFFICENA SEMO PA3X" StrConv ("OFFICENA SEMO PA3X", 2) Result: "officena semo pa3x" StrConv ("OFFICENA SEMO PA3X", 3) Result: "Officena Semo Pa3x" الاستخدام في الاستعلام يكون: الاستخدام في داخل محرر الـ VBA يكون: StrConv([CategoryName],3) تحياتي للجميع.. SEMO.Pa3x

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

السلام عليكم تفضل اخي الكريم ارجو ان يكون طلبك Dim appExcel As Object On Error Resume Next Set appExcel = GetObject(, "Excel.Application") appExcel.Application.DisplayAlerts = False appExcel.Application.Save appExcel.Application.DisplayAlerts = True appExcel.Application.Quit Set appExcel = Nothing

السلام عليكم مؤخراً قمت بعمل مشروعٍ لمعالجة بيانات جهاز البصمة الإلكترونية Fingerprint Scanner ، ومن ضمن مراحل العمل احتساب الإجازات الساعية شهرياً وذلك بتحويلها إلى يوم إجازة، ونظراً لكون المشروع يتعلق بخصوصية المكان المنفذ لأجله مع التعقيدات القانونية المتعلقة بذلك، فقد اختصرت العمل لما يبين هذه الجزئية فقط، بعد أن وجدت من يسأل عنها؛ عسى أن يكون في هذا العمل ما ينفع، مع بعض الأكواد البسيطة التي قد يُحتاج إليها. أللهم صلِ على سيدنا محمد وعلى آله وصحبه وسلم. ميديا فاير- رابط المثال

السلام عليكم أرفق نسخة مرفوعة على سيرفر الموقع برنامج احتساب البصمة.accdb

الأخ علي لا لزوم لهذه المعادلة الطويلة (لادراج من A الى Z ) تكفي هذه =IF(ROWS($A$1:A1)>26,"",CHAR(64+ROWS($A$1:A1))) ربما تنفع هذه الثلاث كودات Option Explicit Sub insert_arab() Dim i%, k% Dim arr() k = 0 Range("A1").CurrentRegion.ClearContents arr = Array(1, 2, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, _ 18, 19, 20, 21, 23, 24, 25, 27, 29, 30, 31, 32, 39) For i = LBound(arr) To UBound(arr) Range("A" & i + 1) = Chr(198 + arr(k)) k = k + 1 Next End Sub '++++++++++++++++++++++++++++++++++++ Sub insert_Cap() Range("C1").CurrentRegion.ClearContents Dim i% For i = 1 To 26 Range("C" & i) = Chr(64 + i) Next End Sub '++++++++++++++++++++++++++++++++++++++++++ Sub insert_Small() Range("F1").CurrentRegion.ClearContents Dim i% For i = 1 To 26 Range("F" & i) = Chr(96 + i) Next End Sub الملف مرفق ALPHABET.xlsm

برنامج شئون الموظفين مع ارشفةصور المستندات وملفات pdf الباسوورد : 2545 https://youtu.be/A0u_-nowx1s وهذا هو البرنامج برنامج_الموظفين.accdb

السلام عليكم ورحمة الله بفرض جعل القائمة المنسدلة قى الخلية "E3" ضع الكود التالى فى حدث الورقة و تغيير الاكواد Code1 , Cod2 .... الخ باسماء الاكواد التى لديك Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$E$3" Then Exit Sub If Target.Value = "اجمالى" Then Call Code1 ElseIf Target.Value = "دراسة" Then Call Code2 ElseIf Target.Value = "بحث" Then Call Code3 ElseIf Target.Value = "صح" Then Call Code4 Else Exit Sub End If End Sub

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

في الطريقة التي اشار اليها الاستاذ @أحمد الفلاحجى اعتمدت الاستاذة زهرة على وضع حقل غير منظم بالنموذج الفرعي وقيمته تساوي =Nz(Sum([total]);0) وفي حقل الاجمالي للنموذج =Forms![إجمالى فاتورة البيع(مبيعات الأسمنت]![تفصيل فاتورة البيع]!TOT ومكن اختصار الطريقة بدون الحاجة للحقل غير المنظم في الفرعي باستخدام دالة dsum =Nz(DSum("[total]";"تفصيل فاتورة البيع";"[im_id]='" & [im_ID] & "'");0) المثال في المرفق TOTAL.accdb

اساتذتي ومعلمي الاحباء الف الف شكر الحقيقة هذا اكثر من استحقاقي اين انا من هؤلاء الاهرامات والاساتذة الذين اتحفونا وما زالوا يتحفونا باجوبتهم شكرا لاستاذنا jjafferr والشكر موصول لاساتذتي واخوتي Shivan Rekany أحمد الفلاحجى ابو البشر Khalid Jnb ابوخليل wael_rafat أبو إبراهيم الغامدي essam rabea kha9009lid ابو محمد 316 m.r

وعليكم السلام اخي حمدي 🙂 وشكرا جزيلا لك 🙂 جعفر

مشاركة مع اصدقائي لكي يظهر كل السجلات فقط قم بتغير نوع العلاقة بين استعلامين كما مبينة في الصورة شوف النتيجة واليك مرفقك بعد تعديل علاقة TEST.accdb

اخي الفاضل : 1. قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف 2. اخبرك اخوي خالد : 3. اخبرك اخوي شفان ، ان قاعدة البيانات من نوع mde والتي لا يمكن ان تفتحها وترى الاكواد رجاء اخي الفاضل ، الالتزام بقوانين المنتدى 🙂 جعفر

هلا اخي تم التعديل الفكرة هى ضم كل الاسطر في الجدولين...اضفت سطر 8 لجدول IN للتوضيح بالتوفيق TEST-UPDATED.accdb

السلام عليكم هذه مشاركة مع استاذ ابو تراب TEST10.rar

تفضل أخي ListBox to One Row.xlsm

هلا اخي... هل هذا طلبك نفذ الاستعلام Q_IN_OUT_ALL TEST.accdb

وعليكم السلام-على الرغم انك لم تقم برفع ملف موضح عليه المطلوب بكل دقة , الا انى قمت بتصميم هذا لك , بداخل الملف طريقة عمل التسلسل بمعادلة عادية وطريقة أخرى بدالة معرفة Dynamic Serial by Letters.xlsm

كل التحيه والاحترام والود والمحبه فالله اخى واستاذى خالد بارك الله فيك وجزاك الله عنا كل خير اتعلم منكم اخوانى واساتذتى واحاول قدر المستطاع افاده اخوانى لانول معكم الاجر والثواب لعل تصيبنا دعوه صالحه من اخواننا وينول اخوانى واساتذتى منها جزاكم الله خيرا اخوانى واساتذتى

اخي واستاذنا الفاضل @Khalf لا مشكله اخي جميعنا نعمل لهدف واحد بارك الله فيك ولك وسوف اقوم بعون الله بتحميل المثال وتجربته عندما يتوفر لدي جهاز يدعم تطبيقات ميكروسوفت فائق التقدير والاحترام 🌹 تحية اجلال واحترام لاخينا واستاذنا ابو بسمله الجميل في اخلاقة والجميل في تفانيه في خدمة الجميع 🌹

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

اتفضل اليك هذا الكود Public Sub Terminate(Process As String, Optional PID As Long = 0) StrPID = IIf(Not PID = 0, " AND ProcessId=" & PID, "") Set Obj = GetObject("winmgmts:\\.\root\CIMV2") Set ColItems = Obj.ExecQuery("SELECT * FROM Win32_Process WHERE Name='" & Process & "'" & StrPID, , 48) For Each Obj In ColItems Obj.Terminate Next End Sub تقدر ان تغلق كل انواع البرامج بهذه الطريقة فقط عليك ان تكتب اسم البرامج عند تدعيه مثلا هنا نريد ان نغلق ملفات اكسل المفتوحة هكذا سنستدعيه عند الضغط على الزر Private Sub Command28_Click() Call Terminate("Excel.exe") End Sub

Application.Sum(Sh.Cells(i, 1). _ Offset(, 4).Resize(, 5) في هذا السطر الرقم 5 في ((Resize(, 5) هو عدد الأعمدة التي تريد جمعها ابتداء من العامود الذي مسجل في (Offset(, 4 وتضيف عليه 1 (4+1)=5 (العامود E رقمه 5) مثلا اذا كنت تريد جمع عامود واحد تكتب (Resize(, 1 العامود فقط E اذا كنت تريد جمع عامودين تكتب (Resize(, 2 العامودين E و F

بسم الله الرحمن الرحيم تطرق الكثير من المبرمجين إلى موضوع التفقيط وهو تحويل الأرقام إلى كلمات عربية ولكني كمعلم لمادة اللغة العربية لم أجد من هذه الدوال ما يتوافق مع قواعد اللغة العربية قاعدة كتابة الأعداد العربية بطريقة مضبوطة وصحيحة وتجد في هذا الرابط شرح مبسط للعدد وتمييزه http://www.reefnet.g.../AdadMadoud.htm وبفضل الله قمت ببرمجة دالة تقوم بتحويل الرقم إلى كلمات عربية مضبوطة تماماً وموافقة لجميع قواعد كتابة العدد في اللغة العربية تجدها هنا https://officena.net/team/mas/tafkeet وتم برمجة هذه الصفحة بلغة php وهذا الإصدار الجديد يعتمد فقط علي جافاسكريبت https://www.mr-mas.com/p/tafqeet.html وإذا لاقى الموضوع قبولا وإعجابا فسوف أعرض عليكم الكود الخاص بهذه الدالة أخوكم محمد صالح مبرمج بأكثر من لغة برمجة ومصمم ومطور مواقع

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

أستاذ منتصر احمد الدعيس أين الضغط على الإعجاب لهذه الإجابة الممتازة ؟!!💙

وعليكم السلام والرحمة تفضل اخي العزيز هذا المرفق وهو منقول للامانة اعتقد من احد المواقع الاجنبية قد يكون فيه طلبك Animation2k.rar

تفضل ملف_تطبيق_الجمع_بشروط.xlsm

اتفضل اخى الفاضل ده مثال كان موجود عندى لعله يفى بالغرض ان شاء الله وجزاها الله خيرا ام عهود بالتوفيق اخى جمع فى نموزج فرعى-TOTAL.rar

الاخ احمد الفلاحجي ... الله يوفقك ...تحياتي لكم ...

مبارك عليك أستاذ حسام شارة الخبراء.. تمنياتي لك بمزيد من النجاح..

تم التعديل Sub Salim_Total_new() If ActiveSheet.Name <> "Taksim" Then Exit Sub k = [S2]: My_Sum = "SUM OF :" & k Application.ScreenUpdating = False lr1 = [A9999].End(xlUp).Row Cells(lr1 + 2, 1).EntireRow.Delete Start_Row = 2 Last_Sum = lr1 - 2 'start row for the sum sm_n = Int(Last_Sum / k) + 1 'Number of the sum_lines On Error Resume Next '============================= Range("L3:L" & lr1).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete '============================ On Error GoTo 0 lr = [A9999].End(xlUp).Row For i = 1 To sm_n X = k + Start_Row ' X is end row for the sum If X > (lr + 1) Then X = lr + 1: k = X - Start_Row lr = lr + 1 Rows(X).Rows.Insert Shift:=xlDown Cells(X, "L") = My_Sum Cells(X, "M").Resize(, 4).FormulaR1C1 = "=SUM(R[-" & k & "]C:R[-1]C)" Cells(X, "O") = vbNullString With Range(Cells(X, 1), Cells(X, "P")) .Interior.ColorIndex = 6 .Font.Bold = True .Font.Size = 14 End With Start_Row = Start_Row + k + 1 If Start_Row > lr Then GoTo 10 Next i 10 Application.ScreenUpdating = True totalsum_new With Range("A2:Q" & lr1 + 2) .Value = .Value .Borders.LineStyle = 1 End With End Sub Sub totalsum_new() LAST = [A9999].End(xlUp).Row + 2 Cells(LAST, "L") = "òALL SUM " Cells(LAST, "M").Resize(, 4).Formula = "=SUM(M3:M" & LAST - 1 & ")/ 2" Cells(LAST, "O") = vbNullString With Cells(LAST, "L").Resize(, 5) .Font.Bold = True .Font.Size = 14 .Interior.Color = 10092492 End With End Sub الملف مرفق صفحة" Taksim" Sum_Of-10.xlsm

مبارك استاذ حسام زادك الله علما ونفع بك

مشاركه مع اخوانى واساتذتى الافاضل شوف المرفق لعله يكون طلبك TEST(3).accdb

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

أستاذ @kha9009lid واخجلي منك لقد استخدمت كودكم ولكن أشرتٓ إلى أني أخذته من الأستاذ Kaliad jnb

كل شيء ممكن في الاكسيل 1-تغيير اسماء الصفحات ليتعرف عليها الاكسل بشكل جيد من جهة ومن جهة ثانية اسهل في كتابة الكود ونسخه ولصقه 2-التاريخ في الخلية B15 يجب ان يكتب كتاريخ وليس تاريخ ومعه الحرف م 3- الخلايا المدمجة في الصف الأول لا أنصح بها (لانها تسبب مشاكل في تحديد اخر صف فيه بيانات) 4- اذا كان التاريخ خطأ B15 تحصل على رسالة يذلك و يتوقف الكود عن العمل الكود Option Explicit Sub tansform_data() Dim B As Worksheet, Var_sh As Worksheet Dim Jour%, Mois%, Last_row% Dim Spec_rg As Range Set B = Sheets("By_jour") Set Spec_rg = B.Range("A15") If Not IsDate(Spec_rg) Then MsgBox "You Enter a wrong Date Please Justify" Exit Sub End If Jour = Day(Spec_rg): Mois = Month(Spec_rg) Select Case Mois Case 4 Select Case Jour Case Is <= 15 Set Var_sh = Sheets("Ap1") Case Else Set Var_sh = Sheets("Ap2") End Select '+++++++++++++++++++++++++++++ Case 5 Select Case Jour Case Is <= 15 Set Var_sh = Sheets("May1") Case Else Set Var_sh = Sheets("May2") End Select '+++++++++++++++++++++++++++++ Case 6 Select Case Jour Case Is <= 15 Set Var_sh = Sheets("Jun1") Case Else Set Var_sh = Sheets("Jun2") End Select '+++++++++++++++++++++++++++++ Case 7 Select Case Jour Case Is <= 15 Set Var_sh = Sheets("Jul1") Case Else Set Var_sh = Sheets("Jul2") End Select Case Else Exit Sub End Select ' Var_sh.Select Last_row = Var_sh.Range("a:a").Find("", after:=Var_sh.Range("a3")).Row Var_sh.Cells(Last_row, 2).Resize(, 8).Value = _ B.Cells(12, 2).Resize(, 8).Value Var_sh.Cells(Last_row, 1) = Spec_rg End Sub الملف مرفق Tarhil_Youmi.xlsm

كما وضحت لك اذا بحث بالاسم سيظهر الاسم لكن يمكن وضع مربع نص يظهر به رقم الموضف Database110.rar تحياتي

وعليكم السلام ورحمة الله وبركاته لانه لا يوجد لديك حقل باسم PicFile لا في الجدول ولا في النموذج نصيحة : لا تجعل الصور مرفقة في قاعدة البيانات اجعلها في مجلد خاص بالصور بجوار البرنامج وذلك لعدم تضخم قاعدة البيانات بدون فائدة كبيرة FF.rar تحياتي

اخى الفاضل على ما اعتقد قد تم الرد عليك من قبل بواسطه اخى واستاذى خالد

تم معالجة الامر MY_search (2).xlsx

السلام عليكم 🙂 للعلم ، الاداة DBPix تحفظ فقط ملفات الصور ، بصيغة Blob في حقل OLE في جداولك. لإخراج جميع الصور من برنامجك وحفظها في مجلد ، احفظ هذه الوحدة النمطية في برنامجك بإسم mod_Blob_to_File : Option Compare Database Option Explicit ' 'https://www.utteraccess.com/forum/index.php?s=bb0cc83dcb349316e03115efcd24acf4&showtopic=1688201&view=findpost&p=1688652 ' 'modified by jjafferr ' 16-4-2020 ' Public Declare Function apiCreatePath Lib "Imagehlp.dll" _ Alias "MakeSureDirectoryPathExists" (ByVal strPath As String) As Long ' Public Function ExtractFiles() Dim strPath As String, tbl_Name As String strPath = CurrentProject.Path & "\myFiles\" apiCreatePath strPath 'tblItemsTracks tbl_Name = "tblItemsTracks" With CurrentDb.OpenRecordset(tbl_Name) Do Until .EOF If Len(![Picture] & "") <> 0 Then DownloadFieldToFile ![Picture], strPath & tbl_Name & "_" & ![TNo] & "_" & ![Id] & "_Picture.jpg" DownloadFieldToFile ![Thumbnail], strPath & tbl_Name & "_" & ![TNo] & "_" & ![Id] & "_Thumbnail.jpg" End If .MoveNext Loop End With 'tblItemsTracks tbl_Name = "tblItemSubImagesT" With CurrentDb.OpenRecordset(tbl_Name) Do Until .EOF If Len(![imgMain] & "") <> 0 Then DownloadFieldToFile ![imgMain], strPath & tbl_Name & "_" & ![ItemId] & "_" & ![ImageId] & "_imgMain.jpg" DownloadFieldToFile ![imgThumb], strPath & tbl_Name & "_" & ![ItemId] & "_" & ![ImageId] & "_imgThumb.jpg" End If .MoveNext Loop .Close End With MsgBox "Done" End Function Private Sub DownloadFieldToFile(ByRef objFieldName As Object, _ ByVal strFileName As String) Dim intFileNum As Integer intFileNum = FreeFile Open strFileName For Binary As intFileNum Put intFileNum, , objFieldName.GetChunk(0, objFieldName.FieldSize) Close intFileNum End Sub . لتشغيل هذه الوحدة النمطية ، اكتب التالي (رجاء الملاحظة الى ان علامة الاستفهام بالانجليزي وليست بالعربي) ، في النافذة اسفل نافذة الكود (لفتحها اضغط على Ctrl+G) : ?ExtractFiles هذه الوحدة النمطية ستعمل لك مجلد جديد اسمه myFiles داخل مجلدك ، وستحفظ الصور من الجدولين فيه ، لهذا السبب ، رجاء استعمل نسخة من برنامجك للقيام بهذا العمل ، وتأكد بأنه لديك مساحة فارغة على الهارددسك اكثر من 2 جيجا ، وقبل ان تستخدم برنامجك كاملا ، رجاء استعمل ملفات جزء من برنامجك لاصل ، حتى نتفق على اسماء الملفات ، فأنا حاليا حفظت الملفات هكذا : . فقد لا تناسبك التسمية ، وخصوصا اننا يجب ان نربط الصور مع السجلات لاحقا بالاسم الصحيح 🙂 اما بالنسبة لحفظ ملفات الاسكانر بصيغة pdf ، فهناك 3 طرق : 1. الطريقة الاسهل والتي اخبرتك عنها : 2. ان تستعمل الكود في التحكم في الاسكانر (ومنها الطريقة التي طلبتها في تعديل كود المرفق) ، فلا تتعب نفسك ، فلا توجد طريقة سهلة ، 3. ان تجعل الاسكانر يعمل لك صور بصيغة jpg ، وبعدها نستخدم برنامج خارجي ليضم جميع هذه الصور الى ملف واحد بصيغة pdf وطبعا ممكن التحكم بهذا برمجيا ، ولكن العمل يطول والانسب هو الطريقة رقم1 اعلاه : . طبعا بعد ان تخرج الصور من برنامجك ، يجب ان تحذف حقول OLE من جداولك (لا تنسى انك تستعمل نسخة من برنامجك) ، وبعدها اعمل للبرنامج ضغط واصلاح ، وسيرجع الى حجمه الصحيح 🙂 ويجب عليك ان تعيد العمل على برنامجك (ونصيحة ، لا تستعمل الاداة DBPix مرة اخرى في البرنامج ، فانت محتاج الى اظهار الصور فقط في مربع الصور في النموذج/التقرير) ، او اظهر ملف pdf في النموذج/التقرير : جعفر

،عم استخدم هذا الكود Private Sub AGE_AfterUpdate() If Not IsNull(Me.Age.Value) Then Me.DOB.Value = DateSerial(Year(Me.dDate) - Me.Age.Value, 1, 1) End If End Sub 2020 (1).rar

ممكن نجربة هذا الكود اذا لم يكن هناك صفحة بأي اسم يقوم الماكرو باضافة صفحة جديدة بهذا الاسم و ينقل البيانات اليها Option Explicit Sub Add_sheet() Dim myname As Worksheet Dim P As Worksheet Dim sh_n%, k%, i% Set P = Sheets("اليوميه") sh_n = Application.CountA(P.Range("B:B")) - 1 Dim x%, t%: t = 2 Dim mn$ Application.ScreenUpdating = False ''''''''''''''''''''''''''''''''''''''''' For i = 2 To sh_n On Error Resume Next mn = Sheets(P.Range("b" & i) & "").Name x = Len(mn) If x = 0 Then P.Copy after:=Sheets(Sheets.Count) With ActiveSheet .Name = P.Range("b" & i) .Range("G14") = P.Range("F" & i) .Range("a1").CurrentRegion.Offset(1).ClearContents .Range("A:A").NumberFormat = ("dd- mm-yyy") For k = 2 To sh_n + 1 If P.Range("b" & k) = ActiveSheet.Name Then ActiveSheet.Cells(t, 1).Resize(, 4).Value = _ P.Range("A" & k).Resize(, 4).Value t = t + 1 End If Next End With '========================================= Else Set myname = Sheets(P.Range("b" & i) & "") myname.Range("a1").CurrentRegion.Offset(1).ClearContents For k = 2 To sh_n + 1 If P.Range("b" & k) = myname.Name Then myname.Cells(t, 1).Resize(, 4).Value = _ P.Range("A" & k).Resize(, 4).Value t = t + 1 End If Next '''''''''''''''''''''''''''''''''''' End If mn = "" Err.Number = 0 t = 2 Next i P.Select Application.ScreenUpdating = True End Sub الملف مرفق tarhil_by_names.xlsm

بارك الله فيك الشرح موجود داخل الملف الماكرو اسمه الدرجة 1اعمال سنة بالحروف تربية اعدادى رياضيةطبقا للقرار 311 لسنة 2019.xlsm

الاخ waleed907 السلام عليكم هذا البرنامج كان من تصميمي الشخصي وكان بعنوان (برنامج قروض للمبتدئين)اكسس 2003 ورفعته على المنتدى للفائدة منذ مدة ليست ببعيدة ومنتديات اخرى واجريت عليه بعض التعديل ليتوافق مع اكسس 2013 فهل من المعقول ان يظهر بحلة جديدة وبعنوان جديد وباسم مصمم اخر اعتقد ان هذا الامر ........ (مصادرة لجهود الآخرين) اليك البرنامج الاصلي قروض.rar

بسم الله الرحمن الرحيم إخوانى الأعزاء السلام عليكم ورحمة الله وبركاته أقدم لكم اليوم ( سلسلة الفارس فى شرح دوال الإكسل عن طريق الفيديو ) والهدف من هذه السلسلة ( التى أرجو من الله أن أستطيع إكمالها ) هو الآتى : 1- رد جميل هذا المنتدى الذى أدين له ولأساتذته بكل ما لدى من معلومات 2- تقديم مادة علمية شيقة لكل من يحاول تعلم دوال الإكسل تقوم على التفاعل المباشر عن طريق الفيديو لكى يسهل وصول المعلومة فى أبسط صورة 3- صدقة جارية ( أرجو من الله القبول ) وكل ما أرجوه دعوة بظهر الغيب والله من وراء القصد وهو يهدى السبيل بداية السلسلة شرح الدالة IF http://youtu.be/h--yP3NRaQQ if function 1.rar

السلام عليكم ورحمة الله تعالى وبركاته اقدم هذا الموضوع وهذه المشاركة بناء على سؤال فى هذا الموضوع اتأخرت فى الرد على الرغم من انى كان ممكن ارد فى اقل من عشر دقائق الا اننى احببت عمل مصال شامل وكاف وواف 1- الفرز تصاعديا او تنازليا لكل حقل على حده 2- تصفية السجلات بناء على قيمة مربع تحرير وسرد 3- امكانية التصفية المتعدده بناء على اكثر من قيمة من امثر من مربع تحرير وسرد 4- الغاء تصفية السجلات وعرضها جميعا والان اترككم مع المرفق مثال شامل على طريقة الفرزتصاعديا وتنازليا والتصفيه .rar

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