jo_2010

استاذى ومعلمى الخبير الفاضل Foksh خالص الشكر لحضرتك زادك اللة خبرة وعلم الف شكر

الخبراء الافاضل هذا الكود ابتكرة الخبير الفاضل خليفة اعادة الله الى المنتدى بالف سلامة Private Sub EXCEL_Click() Dim folderPath As String Dim FilePath As String Dim FileName As String Dim xlApp As Object Dim xlWB As Object Dim xlWS As Object Dim LastRow As Long Dim lastCol As Long Dim NewRow As Long Dim C As Long ' التأكد من اختيار الشهر والسنة If Len(Me.MS_YR & "") = 0 Then MsgBox "الرجاء اختيار الشهر والسنة أولاً", vbExclamation + vbMsgBoxRight, "تنبيه" Me.MS_YR.SetFocus Exit Sub End If ' إنشاء فولدر حفظ النسخ بجوار القاعدة folderPath = CurrentProject.Path & "\Jo_Excel" If Dir(folderPath, vbDirectory) = "" Then MkDir folderPath ' اسم الملف مع التاريخ والوقت FileName = "اجمالى شــهر _" & Replace(Me.MS_YR.Value, "/", "-") ' "_" & Format(Now, "yyyy-mm-dd_HH-MM-ss") & ".xlsx" FilePath = folderPath & "\" & FileName ' تصدير الاستعلام On Error Resume Next DoCmd.TransferSpreadsheet _ acExport, _ acSpreadsheetTypeExcel12Xml, _ "Q_Total_Company_Excel", _ FilePath, _ True If Err.Number <> 0 Then MsgBox "خطأ عند التصدير: " & Err.Description Exit Sub End If On Error GoTo 0 ' فتح Excel للتنسيق Set xlApp = CreateObject("Excel.Application") Set xlWB = xlApp.Workbooks.Open(FilePath) Set xlWS = xlWB.Sheets(1) xlApp.Visible = True ' آخر صف وعمود LastRow = xlWS.Cells(xlWS.Rows.count, 1).End(-4162).Row ' xlUp lastCol = xlWS.Cells(1, xlWS.Columns.count).End(-4159).Column ' xlToLeft ' ============================== ' تثبيت الصف الأول بدون Select ' ============================== xlWS.Application.ActiveWindow.SplitRow = 1 xlWS.Application.ActiveWindow.FreezePanes = True ' ============================== ' حدود لجميع الخلايا ' ============================== With xlWS.Range(xlWS.Cells(1, 1), xlWS.Cells(LastRow, lastCol)).Borders .LineStyle = 1 .Weight = 2 End With ' تنسيق العناوين With xlWS.Range(xlWS.Cells(1, 1), xlWS.Cells(1, lastCol)) .Interior.Color = RGB(52, 152, 219) .Font.Color = RGB(255, 255, 255) .Font.Bold = True .HorizontalAlignment = -4108 .VerticalAlignment = -4108 End With ' ============================== ' إضافة صف الإجماليات أسفل البيانات ' ============================== NewRow = LastRow + 1 ' دمج أول 4 أعمدة وكتابة "الإجمالي" With xlWS.Range(xlWS.Cells(NewRow, 1), xlWS.Cells(NewRow, 4)) .Merge .Value = "الإجمالي" .Font.Bold = True .HorizontalAlignment = -4108 .VerticalAlignment = -4108 End With ' جمع الأعمدة من الخامس فصاعدًا For C = 5 To lastCol xlWS.Cells(NewRow, C).Formula = _ "=SUM(" & xlWS.Cells(2, C).Address & ":" & xlWS.Cells(LastRow, C).Address & ")" Next C ' تنسيق صف الإجمالي With xlWS.Range(xlWS.Cells(NewRow, 1), xlWS.Cells(NewRow, lastCol)) .Font.Bold = True .Font.Size = 12 .Interior.Color = RGB(255, 255, 0) ' حدود خارجية سميكة With .Borders(7) ' Left .LineStyle = 1 .Weight = 4 End With With .Borders(10) ' Right .LineStyle = 1 .Weight = 4 End With With .Borders(8) ' Top .LineStyle = 1 .Weight = 4 End With With .Borders(9) ' Bottom .LineStyle = 1 .Weight = 4 End With ' حدود داخلية أخف With .Borders(11) ' Inside Vertical .LineStyle = 1 .Weight = 2 End With With .Borders(12) ' Inside Horizontal .LineStyle = 1 .Weight = 2 End With End With xlWS.Columns.AutoFit xlWB.save xlWB.Close xlApp.Quit Set xlWS = Nothing Set xlWB = Nothing Set xlApp = Nothing MsgBox "JO_Excel" & " " & " تـم التصدير ... بنجاح مع حفظ النسخة في فولدر ", vbInformation + vbMsgBoxRight End Sub اريد العمود الاول الذى يتحتوى اسماء الشركات ان يكون راسيا كما بالصورة 2 بدل من افقيا كما بالصورة 1 هل هذا ممكن ام لالا

معلمى الفاضل Foksh شكرا لحضرتك يامبدع الله بجازيك بكل الخير

تقرير يعرض الاستعلام الجدولى مع عرض اي تغيير يتم فى الاستعلام اريد تقرير بنفس سكل التقرير الرسل انظر الصورة التقرير

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

قمة فى الروعة والابداع ذادك الله علما

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

اتحلت المشكلة كثر خيرك زادك الله من علمة

ياشكرا يامبدع زادك الله علما

استاذى الفاضل ومعلمى الخبير Foksh فمت باستبدال القيمة 11 في الدالة لتصبح 2952 الخاصة بعرض التصميم والوضع كما هو انظر الصورة فى التعليق السابق

الخبير الفاضل ممكن لوتكرمت انظر الصورة

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

تشرف وتنور مصر الف مليون سلامة على حضرتك

معلمى الفاضل واستاذى الجليل kkhalifa1960 القاعدة تعمل بصورة اكثر من رائعة لكن لو حضرتك فتحت القاعدة المرسلة لحضرتك هاتفهم قصدى وهو ان المريص يوسف يوسف حضر لعمل تحليل سكر بتاريخ 1/1/2026 وعمل تحليل وطائف كبد بتاريخ 4/1/2026 وعمل اليوم 20/6/2026 تحليل سكر ووظائف كبد ظهرت النتائج السابقة بوظائف الكبد بتاريخ 4/1/2026 ولم يظهر السكر بتاريخ 1/1/2026 مع العلم بانة يعتبر اخر تحليل سكر عملة المريض وهذا مااريدة اخر تحليل مهما حتى لو تكرر زبارة المريض للمعمل لعمل تحاليل اخرى القاعدة الاولى اللى حضرتك بتتكلم عنها تظهر النتائج فيها بصورة جيدة افتح القاعدة وامسح تحليل الموجود بتاريخ 4/1/2026 من الاستعلام Qry_All_Reports وافتح اخر تقرير لن تجد تحليل السكر فية انظر الى الصور بالترتيب لتصل لحضرتك فكرتى خالص الشكر لصبرك لسعة صدرك

استاذى الفاضل ومعلمى الخبير kkhalifa1960 تسلم ايدك على تعبك وشرحك وسعة صدرك جعله الله فى ميزان حساناتك خالص الشكر انظر الصورة واليك القاعدة بعد التعديل فى النتائج لمشاهدة التغيرات Lab_2026-25-6-2026.rar