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

السلام عليكم ورحمة الله وبركاته اهلا بحضرتكم جميعا النهاردة باذن الله هشرح طريقة جديدة .. للتأكد من ملء كافة الحقول قبل الانتقال الى سجل جديد مع الغاء زر الانتر والتاب من الانتقال بهم الى سجل جديد وده شرح فيديو لطريقة تنفيذ الطريقة MS_Be sure to fill in all fields.rar

السلام عليكم ورحمة الله وبركاته تانية طريقة هنشرحها باذن الله هى طريقة .. شرح تصدير البيانات من الاكسس الى ملف ورد معد مسبقا عن طريق الاشارة المرجعية الفيديو https://youtu.be/VtPEat0Qkqo MS_Export data to Word file.rar

السلام عليكم ورحمة الله أحببت أن أشارك معكم في بخصوص هذا الموضوع بطريقة مختلفة بعض الشيء.. أرجو أن تجدوا فيها شيئا جديدا :: تنبيهات --- يتم رسم التقرير برمجيا.. --- عدد السجلات في رأس التقرير ثابتة من ناحية التصميم، متغيرة من ناحية البيانات.. - يتم تفيير البيانات في هذا المقطع وفقا لكميات البيانات.. - تستطيع كمية البيانات في هذا المقطع زيادة عدد صفحات التقرير تناسبا مع مصدر بيانات التقرير.ز - عدد السجلات المعروضة في هذا المقطع (10) سجلات لكل صفحة --- مصدر البيانات الأساسي هو الاستعلام (QRY_MATERIAL) --- يعاد بناء هذا الاستعلام كاستعلام (توحيد) بناءً على الفرضيتين التاليتين: -- التوحيد من أجل تكملة العشرة.. -- يتم إخفاء السجلات الوهمية بفحص معطيات الحقل الوهمي (TEST) - تزيد قيمة هذا الحقل كلما زادت الاستعلامات الوهمية (...،0،1،2) - البيانات الحقيقة تأخذ القيمة (0) --- إذا كانت بيانات مقطع الرأس أكبر من بيانات مصدر البيانات الأساسي -- يزيد عدد الاستعلامات الوهممية بواقع استعلام لكل (10) سجلات لزيادة عدد الصفحات -- يتم احتساب عدد الاستعلامات وتضمينها برمجيا بواسطة الإجراء (UNION_SQL) أرجو ألا تبخلوا بالنقد والتعليق😁 MATRIX REPORT.accdb

تفضل تم عمل كل طلباتك Book2.xlsm

وعليكم السلام-فقط عليك استخدام هذا الكود Sub UnmergeAllCells() ActiveSheet.Cells.UnMerge End Sub

السلام عليكم في الكثير من الأحيان نحتاج إلى معرف مصدر اختصارات سطح المكتب أو إلى معرفة هل هذا البرنامج لديه اختصار على سطح المكتب أم لا؟ نستطيع استخراج مصدر اختصارات سطح المكتب و ملفها من خلال هذا الكود: Dim strFolder As String Dim strDesktop As String Dim typefiche As String Dim strtxt As String typefiche = "\*.lnk" strDesktop = CreateObject("WScript.Shell").SpecialFolders("Desktop") strFolder = Dir(strDesktop & typefiche, vbDirectory) Do While strFolder <> "" If Not (strFolder = "." Or strFolder = "..") Then strtxt = "Full Path: " & CreateObject("WScript.Shell").CreateShortcut(strDesktop & "\" & strFolder).TargetPath & vbCrLf strtxt = strtxt & "Path Folder: " & CreateObject("WScript.Shell").CreateShortcut(strDesktop & "\" & strFolder).WorkingDirectory & vbCrLf MsgBox strtxt End If strFolder = Dir() Loop مصدر اختصارات من سطح المكتب.rar

وعليكم السلام 🙂 بياناتك افقية بهذه الطريقة: . وتم تحويلها عموديا الى جعفر 1142.قاعدة البيانات1.accdb.zip

Option Explicit Dim Criteria_Filter As String Dim Drc As String Dim Img As Object Private Sub phone_Change() If phone.Text <> "" Then phone = Format(phone, "00 00 00 00 00") End If End Sub Private Sub Txt_Filter_Change() 'تصفية بيانات بفلترة ديناميكية 'كود فلترة اسم العميل في الحقل المشار اليه 'Field:=2 بواسطة التكست البوكس If Txt_Filter <> "" Then 'في حالة إذا كانت تكست بوكس لا تساوي فراغ طبق مايلي Criteria_Filter = "*" & Sheets("AutoFilter").Txt_Filter.Text & "*" ' يعني تحديد كلي بمعنى لوأردت التصفية تكون بمعلومات غير الاسم العميل ' معيار التصفية حددنه "*" Range("B7").AutoFilter Field:=2, Criteria1:=Criteria_Filter Else Criteria_Filter = "" Sheets("AutoFilter").Range("B7").CurrentRegion.AutoFilter End If End Sub Private Sub Txt_Filter_GotFocus() Clear End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'كود جلب صورة العميل وبيانته من مسار خارجي 'استعمال الدالة Intersect وتحديد حقل الأسماء Application.ScreenUpdating = False 'Range("$C$8:$C$30")لعملية الفلترة الديناميكية If Not Intersect(Target, Range("$C$8:$C$30")) Is Nothing And Target.Count = 1 Then 'وكل اسم من الأسماء في الحقل يطابق اسم الصورة الموجود في مجلد الصور Drc = ThisWorkbook.Path & "\OFFICINA\" 'مسار مجلد الصور On Error Resume Next Shapes("Image").Delete 'حذف الصورة السابقة عند تحيد اسم العميل الحالي Clear Set Img = ActiveSheet.Pictures.Insert(Drc & Target & ".jpg") 'جلب الصورة بالاستعان بدالةActiveSheet.Pictures.Insert(Drc & Target & ".jpg") CustomerName = Intersect(Target, Range("$C$8:$C$30")) 'تصدير البيانات التكست بوكس والاستعانة بدالة vlookup code = WorksheetFunction.VLookup(CustomerName, [Data], 5, 0) gove = WorksheetFunction.VLookup(CustomerName, [Data], 4, 0) national_id = WorksheetFunction.VLookup(CustomerName, [Data], 2, 0) address = WorksheetFunction.VLookup(CustomerName, [Data], 3, 0) country = WorksheetFunction.VLookup(CustomerName, [Data], 6, 0) phone = WorksheetFunction.VLookup(CustomerName, [Data], 7, 0) With Img ' خصائص وتحريك الصورة .name = "Image" .Width = 50 .Height = 60 .Left = 680 .Top = 15 End With End If End Sub Sub Clear() On Error Resume Next CustomerName = "" code = "" national_id = "" address = "" country = "" phone = "" gove = "" Shapes("Image").Delete End Sub Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) 'الطريقة الثانية بواسطة AdvancedFilter Range("B7:J30").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _ Range("B4:I5"), Unique:=False End Sub Option Explicit Private Sub Workbook_Activate() Call Menu_Formating End Sub Private Sub Workbook_Open() Call Menu_Formating End Sub Option Explicit ' معادلة استخراج أكواد ومحافظات جمهورية مصر العربيةحسب مصلحة السجل المدني Function GovName(national_id As String) As String If Len(national_id) = 14 And Not IsEmpty(national_id) Then Select Case Mid(national_id, 8, 2) Case "01": GovName = "القاهرة" Case "02": GovName = "الإسكندرية" Case "03": GovName = "بور سعيد" Case "04": GovName = "السويس" Case "11": GovName = "دمياط" Case "12": GovName = "الدقهلية" Case "13": GovName = "الشرقية" Case "14": GovName = "القليوبية" Case "15": GovName = "كفر الشيخ" Case "16": GovName = "الغربية" Case "17": GovName = "المنوفية" Case "18": GovName = "البحيرة" Case "19": GovName = "الإسماعيلية" Case "21": GovName = "الجيزة" Case "22": GovName = "بني سويف" Case "23": GovName = "الفيوم" Case "24": GovName = "المنيا" Case "25": GovName = "أسيوط" Case "26": GovName = "سوهاج" Case "27": GovName = "قنا" Case "28": GovName = "أسوان" Case "31": GovName = "البحر الأحمر" Case "32": GovName = "الواد الجديد" Case "33": GovName = "مطروح" Case "34": GovName = "شمال سيناء" Case "35": GovName = "جنوب سيناء" Case "86": GovName = "مدينة الاقصر" Case "88": GovName = "خارج الجمهورية" Case Else: GovName = "راجع الرقم؟؟" End Select End If End Function Sub Menu_Formating() 'كود إخفاء شريط Ribbon With Application .ScreenUpdating = False .EnableEvents = True .ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",false)" .DisplayFormulaBar = False .DisplayStatusBar = False .Caption = "استعلام مفلتر بالأسماء والصورة" With ActiveWindow .DisplayHorizontalScrollBar = False .DisplayVerticalScrollBar = False .DisplayGridlines = False .DisplayHeadings = False .DisplayWorkbookTabs = False End With End With End Sub الملف مدرج من مركز الخليج وهذا رابط اخر ايسر بدون كلمة سر استعلام مفلتر بالأسماء والصورة استعلام بتصفية ديناميكية بالاسماء والصورة https://www.gulf-up.com/jc2dksuow5am كلمة المرور : mo77996931 لرفع الملف من مركز الخليج دخول إلى مطور فيجوال بيسيك : كلمة المرور : mo77996931

أخى الحسن هل فى المرفق ما تريده تم إضافة "الكل" لـ cboAddName جرب وأفدنى إن لم يكن هو المطلوب والله الموفق AddressSearch.rar

مساهمة مع استاذي خالد إذا كانت المادة غير موجودة في القائمة ستخرج رسالة هل تود إضافة المادة أم لا . أما مطلوب الحذف تم أيضا Sub.mdb

تم عمل المطلوب وجود الخلايا الفارغة في الجدول يسبب هذه المشكلة ttt_new.xlsm

السلام عليكم ,,, الرجاء مراجعه الملف وارجو ان تجد به ما طلبت اخي الكريم ... Time.xlsx

تفضل لك ما طلبت-طبعا بعد اذن استاذ ابو ايسل الاجازة.xlsx

وعليكم السلام -تفضل اغلاق ملف اكسل بعد 5 دقائق بكود بدون تدخل من المستخدم وهذا كود اخر يمكنك استخدامه بوضعه فى حدث ThisWorkbook ____لإغلاق ملف الإكسيل بعد 50 ثانية كمدة خمول Dim xTime As String Dim xWB As Workbook Private Sub Workbook_Open() On Error Resume Next xTime = Application.InputBox("Please specify the idle time:", "KuTool For Excel", "00:00:50", , , , , 2) Set xWB = ActiveWorkbook If xTime = "" Then Exit Sub Reset End Sub Private Sub Workbook_SheetActivate(ByVal Sh As Object) On Error Resume Next If xTime = "" Then Exit Sub Reset End Sub Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) On Error Resume Next If xTime = "" Then Exit Sub Reset End Sub Sub Reset() Static xCloseTime If xCloseTime <> 0 Then ActiveWorkbook.Application.OnTime xCloseTime, "SaveWork1", , False End If xCloseTime = Now + TimeValue(xTime) ActiveWorkbook.Application.OnTime xCloseTime, "SaveWork1", , True End Sub ثم اضافة هذا الكود بمديول عادى Sub SaveWork1() Application.DisplayAlerts = False ActiveWorkbook.Save ActiveWorkbook.Close Application.DisplayAlerts = True End Sub وهذا ملف للعمل مسجل عليه هذه الأكواد حفظ وإغلاق ملف إكسيل تلقائيا بعد وقت خمول معين.xlsm

أخى الكريم فوزى يجب عليك الإنتباه جيدا عند رفع المشاركة ,فقبل رفع المشاركة لتجنب اهدار وقت الأساتذة فعليك اولا استخدام خاصية البحث بالمنتدى هل ما اطلبه موجود وتم نقاشه بالفعل سابقا ام لا ؟!!! كما انه عند عمل قوائم للفصول من صفحة البيانات لابد من اختيار فصل واحد وليس اكثر من فصل , فلما اذن قمنا بعمل هذه القوائم من الأساس اذا كان هناك اكثر من فصل فلا يمكن ان يكون هذا طبيعى ومنطقى فى العمل فهناك مئات المشاركات التى تناولت طلبك , فعليك اختيار منها ما يناسبك : برنامج لعمل قوائم الفصول 2018 عمل قوائم للفصول تلقائية قوائم فصول زيادة عدد الطلبة فى قائمة الفصول اسماء الفصول

عليك السلام ورحمة الله وبركاته تفضل جلوس 2019.xls

تفضل لك ما طلبت محمد_2020.xlsb

ربما ينفع هذا الكود Option Explicit Sub remov_dup() Dim r%, col%, i%, k%, m%: m = 2 Dim dic As Object r = Cells(Rows.Count, 1).End(3).Row Cells(2, "j").CurrentRegion.ClearContents For i = 2 To r Set dic = CreateObject("Scripting.Dictionary") col = Cells(r, Columns.Count).End(1).Column Cells(m, 10) = Cells(i, 1) For k = 2 To col dic(Cells(i, k).Value) = vbNullString Next k Cells(m, 11).Resize(, dic.Count) = dic.keys m = m + 1 dic.RemoveAll Next i Set dic = Nothing End Sub الملف مرفق Salim 3.xlsm

وعليكم السلام ورحمة الله وبركاته استخدم الكود التالي =DSum("[مبلغ الباقي]";"[الوصل]";"[اسم العميل] ='" & [ اسم العميل] & "'") ولكن يجب ادخال اسم العميل في جدول الوصل تحياتي 1212.rar

وعليكم السلام ورحمة الله وبركاته تفضل اخي الكريم Applicants - FF.rar تحياتي

وعليكم السلام-تفضل تم عمل المطلوب بمعادلات الصفيف بعد ضبط تسمية صفحات الملف برنامج التنسيق 1.xlsm

فورم تسجيل البيانات والبحث عنها مع الصور الفيديو

الكود بالشكل بالتالي يعمل ان شاء الله Dim i As Integer Dim db As DAO.Database Dim rs As DAO.Recordset Dim x As Integer Set db = CurrentDb Set rs = db.OpenRecordset("Table1") x = rs!No.Value For i = 0 To 2 If x = Me.MNo Then DoCmd.OpenForm "Dashboard" ElseIf x <> Me.MNo Then DoCmd.OpenForm "Copy" End If Next i واعتقد انك لو استخدمت الكود بدون For ... Next سيكون افضل Dim i As Integer Dim db As DAO.Database Dim rs As DAO.Recordset Dim x As Integer Set db = CurrentDb Set rs = db.OpenRecordset("Table1") x = rs!No.Value If x = Me.MNo Then DoCmd.OpenForm "Dashboard" ElseIf x <> Me.MNo Then DoCmd.OpenForm "Copy" End If تحياتي المعذرة استاذتا الفاضل @خالد سيسكو لم انتبه الى ردك فارجو المعذرة ولك الشكر تحياتي

ارفق ملفك اخي الكريم ليتم التعديل عليه ان شاء الله تحياتي

أ.إبراهيم عطا المرفق لا يوجد به نماذج .. علما بأنك أضفت للإستعلام حقل Expr1: Int([Years]) والذى يقوم بدوره بتحويل النص الى رقم وللتأكد شغل الإستعلام المسمى ConvertToInt بالمرفق والذى ينشئ جدول جديد إسمه Tbl_YearToInt إفتحه فى وضع التصميم .. ستجد أن الحقل Expr1 نوعه رقم. المثال المرفق.rar

أ.إبراهيم عطا جرب Int(TextBox) أو أرفق مثال للتطبيق عليه

تحتاج الى تعريف النوع (تاريخ) في جملة الاس كيو ال # ثم تنسيق التاريخ contractw.accdb

وعليكم السلام-المطلوب غير واضح لنجاح اى مشاركة لابد من رفع ملف مدعوم بشرح كافى ووافى عن المطلوب والا لا تنتظر المساعدة من احد وطالما حضرتك لم تقم برفع ملف -فتفضل https://www.zadschool.com/ms-office/5009/how-to-set-row-height-and-column-width-in-excel.html

كما اشار استاذنا الحبيب احمد زمان بإمكانك استخدام التصفية او في حالة ملفك بشكلة الحالي وعدد الاسطر بالامكان استخدام هذا التعديل Sub MUTAKHEEN_ALL() Dim FS As Worksheet, TS As Worksheet Dim ER, FSN, FR, TR, A, Rw Dim Rn As Range Dim Rng As Range Set App = WorksheetFunction Set TS = Sheets("تأخير") TS.Range("A6:S500").Clear TR = 6 For FSN = 1 To Sheets.Count Set FS = Sheets(FSN) If FS.Name = TS.Name Then GoTo 9 With FS On Local Error Resume Next A = App.Match(.Name, TS.Range("J:J"), 0) If Err <> 0 Then If App.CountIf(.Range("N:N"), "<0") = 0 Then GoTo 9 Rw = TS.Cells(TS.Rows.Count, "J").End(xlUp).Row + 1 TS.Rows(2).Copy TS.Range("A" & Rw) TS.Range("A3:Q5").Copy TS.Range("A" & Rw + 1).PasteSpecial xlPasteFormats TS.Range("A" & Rw + 1).PasteSpecial xlPasteValues TS.Range("J" & Rw + 1).Value = .Name Err.Clear End If TR = App.Match(.Name, TS.Range("J:J"), 0) + 3 For FR = 5 To 999 If .Cells(FR, 14) < 0 Then For FC = 1 To 17 If Not IsNull(TS.Cells(TR, FC).Borders.Value) Then TS.Cells(TR, FC).Borders.Weight = xlThin TS.Cells(TR, FC) = .Cells(FR, FC) Next FC TS.Cells(TR, 19) = .Name TR = TR + 1 End If Next FR Set Rn = TS.Range("B" & Rw + 1 & ":Q" & TR - 1) If Rng Is Nothing Then Set Rng = TS.Range("B3:Q" & TR - 1) Else Set Rng = Union(Rng, Rn) End If End With 9 Next FSN If Not Rng Is Nothing Then With TS.PageSetup .PrintArea = Rng.Address .CenterHorizontally = True .CenterVertically = False .Orientation = xlLandscape TS.PrintPreview End With End If Set TS = Nothing: Set FS = Nothing: Set App = Nothing Set Rn = Nothing: Set Rng = Nothing End Sub

مرحبا اخي @rey360 مثل ماذكرت في ردي السابق اذا الاوفيس لديك من 2003 فما دون يمكن عملها من خلال اكسس ومثل طلبك عمودية وبدون اي مجهود والطريقة سبق شرحها في العديد من المواقع اما الاصدارات من 2007 فما فوق فالطريقة اكثر تعقيد وتتطلب كتابة اكواد اكس ام ال اضافة الى ان القوائم اصبحت تجمع ما بين القوائم والادوات مع ذلك يمكن عملها بشكل عمودي ولكن بشكل مختلف قليلا عن الاصدارات السابقة وربما اجد الوقت لشرح الطريقة عن كيفية كتابة الكود وطريقة اخرى عن طريق برامج مساندة

السلام عليكم بعد اذن استاذنا الحبيب احمد زمان هذا تعديل بسيط على الكود Sub MUTAKHEEN_ALL() Dim FS As Worksheet, TS As Worksheet Dim ER, FSN, FR, TR, A, Rw Set App = WorksheetFunction Set TS = Sheets("تأخير") TS.Range("A6:S500").Clear TR = 6 For FSN = 1 To Sheets.Count Set FS = Sheets(FSN) If FS.Name = TS.Name Then GoTo 9 With FS On Local Error Resume Next A = App.Match(.Name, TS.Range("J:J"), 0) If Err <> 0 Then If App.CountIf(.Range("N:N"), "<0") = 0 Then GoTo 9 Rw = TS.Cells(TS.Rows.Count, "J").End(xlUp).Row + 1 TS.Rows(2).Copy TS.Range("A" & Rw) TS.Range("A3:Q5").Copy TS.Range("A" & Rw + 1).PasteSpecial xlPasteFormats TS.Range("A" & Rw + 1).PasteSpecial xlPasteValues TS.Range("J" & Rw + 1).Value = .Name Err.Clear End If TR = App.Match(.Name, TS.Range("J:J"), 0) + 3 For FR = 5 To 999 If .Cells(FR, 14) < 0 Then For FC = 1 To 17 If Not IsNull(TS.Cells(TR, FC).Borders.Value) Then TS.Cells(TR, FC).Borders.Weight = xlThin TS.Cells(TR, FC) = .Cells(FR, FC) Next FC TS.Cells(TR, 19) = .Name TR = TR + 1 End If Next FR End With 9 Next FSN Set TS = Nothing: Set FS = Nothing: Set App = Nothing End Sub

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

السلام عليكم مالذي تريد عمله بالضبط المرفق به طلبك بخصوص الاختيار A_1.xlsm

جرب هذا الكود بعد اذن الاساتذه الافاضل Dim Ar() Dim i Private Sub Merg_Ali() Dim C As Range Dim A As String Dim B Sp False Erase Ar: i = 0 For Each C In ActiveSheet.UsedRange.Cells If C.MergeCells Then If i >= 1 Then If Ar(1, i) = C.MergeArea.Address Then GoTo nx End If i = i + 1 ReDim Preserve Ar(1 To 2, 1 To i) A = C.MergeArea.Address: B = C.Value Ar(1, i) = A: Ar(2, i) = B nx: C.UnMerge End If Next Sp True If i Then Ar = Application.Transpose(Ar) End Sub Private Sub Ad(A) Sp False For x = LBound(A, 1) To UBound(A, 1) Range(A(x, 1)) = A(x, 2) Next Sp True End Sub Sub Ali_Mr() Merg_Ali If i Then Ad Ar: Erase Ar: i = 0 End Sub Private Function Sp(Bl As Boolean) With Application .ScreenUpdating = Bl .EnableEvents = Bl End With End Function

مرحبا باخونا واستاذنا الغالي تفضل استاذنا ارجو ان ينال اعجابك XFilter.accdb تحياتي

اوافقك تماما في فائدتها اصبحتاستخدمهاكثيرا .. هنا مثال اخر

اخي العزيز يمكن اخفاءة من الخصائص ( بيانات - السماح بعملية تحرير قوائم القيم - اجعله- لا) وشكرا

تفضل اخي العزيز ارجو ان يكون طلبك asd.rar

بعد شرح أخى جعفر زاده الله علما فلا مجال للحديث .. ولكنى أحببت المشاركة من أجل المشاركة 😊 ضع ملف الإكسيل فى نفس مسار قاعدة البيانات بنفس المسمى 01.xlsx وجرب المرفق وستكون النتيجة بجدول إسمه Nom .. عسى أن يكون المطلوب بالتوفيق ImpotrFromExcel.accdb

ألف مبروك للخبيرين يستاهلو أكثر ننتظر منكم المزيد إن شاء الله

جربي المرفق عن طريق استعلام الحاق مجلد جديد (10).rar طبقي الخطوات التي في الصورة وسيعمل باذن الله الاستعلام يتم عملة في القاعدة التي تحتوي على البيانات وليست الفارغة المثال المرفق لن يعمل بشكل صحيح حتى تقوم باختيار المسار الصحيح للقاعدة الفارغة من خلال فتح الاستعلام في وضع التصميم ثم النقر على ايقونة الحاق ثم اختيار مسار القاعدة الفارغة

جرب الملف التالي TEST_3.xlsx

بارك الله فيك وجزاك الله كل خير

السلام عليكم 🙂 بعد النظر في الاستعلامين ، فالاستعلامين يختلفون عن بعض ، ولا يمكنك ان تحصل على نفس النتيجة !! مثال: اعمل استعلام ، واربط الاستعلام الثاني كما هو ، بالجدول. لن تحصل على النتيجة المطلوبة ، لماذا ، لأن الاستعلام الثاني فيه حقل مخفي يقوم بعمل التجميع ولكنك لم تظهر قيمته ، اذن ، اظهر الحقل الثالث في الاستعلام 2 ، واحفظ الاستعلام ، اعمل استعلام ، واربط الاستعلام الثاني بعد التعديل ، بالجدول. فإنك تحصل على النتيجة المطلوبة ، لماذا ، لأنه تم ربط الاستعلام الثاني بالجدول بكامل معاييره وتجميعه للبيانات. جعفر

تفضل استاذ محمد وهذه هى اخر طريقة للإضافة يمكنك تعلمها من هذا الفيديو ,وليس هناك اية طرق اخرى لذلك كيفية إضافة الدوال المخصصة بشكل دائم في جميع ملفات اكسل VBA

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

السلام عليكم ورحمة الله تم عمل المطلوب في الملف المرفق حيث تم ربط المعادلات برقم الحساب وليس باسم الحساب... بالنسبة لعمل ذلك بالأكواد أعتذر منك كثيرا لأني لا أجيدها كثيرا ولعل أحد الإخوة يتفضل بالقيام بذلك... بن علية حاجي ترحيل بيانات من شيت رئيسي الي شيت آخر ( بمعادلات او اكواد ) المهم 1النتيجة - ا-بن عليه (1).xls

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

ولاثراء الموضوع جرب الاختيارات من تنسيق الخلايا باختيار تنسيق مخصص وتحديده

تحياتي الخالصة تم عمل المطلوب بالتعديل على معادلات "الترتيب - 2" (وهي معادلات صفيف لكن لا تحتاج إلى تأكيدها بواسطة ctrl+shift+enter). أرجو أن يفي الغرض المطلوب... بن علية حاجي ترتيب اوائل الفصول.rar