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

هذا التطبيق الرائع لا غنى عنه ... وطبعا الجواب من العنوان.. هدية الى أحبابي ملاحظة هامة للأمانة وحفظاً للحقوق هذا العمل الرائع أنا فقط قمت بالتطوير واضافة بعض التغيرات التي تناسبني ولا أتذكر لمن أو من أين حصلته فالدعاء لصاحبة جزاه الله كل الخير ونسأل الله تعالى أن يجعل هذا العمل علم ينتفع به ويكتبه له في موازين حسناته صدقة جارية ان شاء الله المرفق Full Control Of Print Report.mdb

حبايب اسهل طريقة لعمل progress bar تحياتي ان شاء الله يفيدكم progress bar.rar

وعليكم السلام -يمكن جعل الأكواد هكذا Private Sub Option2_Click() If Option2.Visible = True Then frm1.Hide Sheets("Ý.1.Ë.Ú").Visible = True Sheets("Ý.1.Ã").Visible = False Sheets("Ý.1.Ë.Ã").Visible = False End If End Sub Private Sub Option1_Click() If Option1.Visible = True Then frm1.Hide Sheets("Ý.1.Ã").Visible = True Sheets("Ý.1.Ë.Ú").Visible = False Sheets("Ý.1.Ë.Ã").Visible = False End If End Sub Private Sub Option3_Click() If Option3.Visible = True Then frm1.Hide Sheets("Ý.1.Ë.Ã").Visible = True Sheets("Ý.1.Ã").Visible = False Sheets("Ý.1.Ë.Ú").Visible = False End If End Sub التنقل بين الصفحات.xlsb

السلام عليكم ورحمة الله تعالى وبركاته أستاذي الجليل و معلمي القدير و والدي الحبيب الأستاذ @ابوخليل حياكم الله وبياكم اشتاقت نفسى اليكم كثيرا طبعا وبكل تأكيد يا أستاذ @محمد التميمي أستاذي الجليل و معلمي القدير و والدي الحبيب أعطي الإجابة كما ينبغي وبعد اذن أستاذي الجليل و معلمي القدير و والدي الحبيب أهدى أخي الحبيب هذه القاعدة التخصصية في أمور الطباعة والطابعات Full Control Of Print Report.mdb

Try This file adel1.xlsx

السلام عليكم 🙂 عندنا تقرير بهذه الطريقة : . ونريد نعملة بهذه الطريقة : . نعمل التقرير ، ثم نعمل مجاميع لأي من الحقول ، ثم نعمل حقل ليحسب عدد السجلات للمجموعة : . ويجب عمل برواز الحقول شفاف : ---------------------------------------------------------------------- التعديل - 1 ، 27/11/2020 تصحيح البرنامج ، على فرضية اطوال السجلات مختلفة وتحتوي على اكثر من سطر ثم نرسل هذه البيانات للوحدة النمطية Box_Lines التي تقوم بعمل البرواز : نرسل اسم الحقل المطلوب عمل المربع الكبير حوله ، ولون الخط ، ولون البرواز ، وعدد سجلات المجموعة : Private Sub Detail_Print(Cancel As Integer, PrintCount As Integer) 'No way to adjust the field Height, so we Draw a Box around the new Height Call apply_Max_Height("rpt", 0, "save", RGB(221, 217, 195)) 'Expand the field to be the size of the combined Records 'Call Box_Lines(fld , Text Fore color, Border Color, Group_Record_Count) 'Call Box_Lines(Me.Name, "save", vbBlack , vbBlack , Me.save_Footer) Call Box_Lines(Me.Name, "save", RGB(16, 37, 63), RGB(221, 217, 195), Me.save_Footer) End Sub . واستخدمت الوحدة النمطية لأخونا العود ابو خليل من هنا ، لضبط اطوال جميع السجلات الى الاطول : طلب كود تنسيق نمو حقول التقرير - قسم الأكسيس Access - أوفيسنا (officena.net) وتقوم الوحدة النمطية Box_Lines بعمل المطلوب ، بعمل حقل واحد (للجقل المطلوب) : Option Compare Database Option Explicit Dim str_Text As String Dim int_Counter As Integer Public fildMaxHeight As Integer Dim ctl As Control ' Public Function Box_Lines(rpt_Name As String, fld_Name As String, rgb_Fore As Long, rgb_Border As Long, Group_Record_Count As Integer) Dim L As Single Dim T As Single Dim W As Single Dim H As Single Set ctl = Reports(rpt_Name)(fld_Name) 'make it simple to understand L = ctl.Left W = ctl.Width T = ctl.Top H = ctl.Height 'take the highst Height If fildMaxHeight > H Then H = fildMaxHeight End If 'this is to know when a new Group starts If ctl <> str_Text Then str_Text = ctl int_Counter = 1 End If ctl.BorderColor = vbWhite ctl.ForeColor = vbWhite Reports(rpt_Name).Line (L, T)-(L, W), rgb_Border 'Left Line Reports(rpt_Name).Line (W, T)-(W, H), rgb_Border 'Right Line 'COULDN'T GET IT TO WORK ' If int_Counter = Group_Record_Count Then 'Last Record ' Reports(rpt_Name).Line (L, H)-(W, H), rgb_Border 'Bottom Line ' End If If int_Counter = 1 Then 'First Record ctl.ForeColor = rgb_Fore 'Text ForeColor Reports(rpt_Name).Line (L, T)-(W, T), rgb_Border 'Top Line End If int_Counter = int_Counter + 1 End Function Public Function find_Max_Height(rpt_Name As String, Section_Number As Integer) fildMaxHeight = 0 For Each ctl In Reports(rpt_Name).Section(Section_Number).Controls If ctl.Height > fildMaxHeight Then fildMaxHeight = ctl.Height End If Next End Function Public Function apply_Max_Height(rpt_Name As String, Section_Number As Integer, Exclude_fld_Name As String, rgb_Border As Long) fildMaxHeight = 0 'get the max Height For Each ctl In Reports(rpt_Name).Section(Section_Number).Controls If ctl.Height > fildMaxHeight Then fildMaxHeight = ctl.Height End If Next 'Draw lines around the fields For Each ctl In Reports(rpt_Name).Section(Section_Number).Controls If ctl.Name <> Exclude_fld_Name Then Reports(rpt_Name).Line (ctl.Left, ctl.Top)-Step(ctl.Width, fildMaxHeight), vbWhite, BF Reports(rpt_Name).Line (ctl.Left, ctl.Top)-Step(ctl.Width, fildMaxHeight), rgb_Border, B End If Next End Function . -------------------------------------------------------------------- النسخة اعلاه فيها خطأ ، فرجاء استعمال النسخة الاحدث ، والتي نستطيع فيها العمل على اكثر من حقل : جعفر 1293.1.Report_Draw_BoxLine.mdb.zip

المحاضرة الثانيه في دورة احتراف دوال ومعادلات الإكسل تابع معانا #we_love_mohammad_ﷺ_challenge #إلا_رسول_الله #عذرا_رسول_الله #مقاطعه_المنتجات_الفرنسيه #مقاطعه_فرنسا

تفضل Convert exe to xls

مشكور جدا استاذ علي وان شاء الله في ميزان حسناتك

السلام عليكم جرب الآن... برنامج فحص (3).xlsx

لك تئبرني وتكفني انت ومعلمي وتاج راسي الاستاذ جعفر

@ابا جودى بس بدي افهم ليش عم تضحك

لا حاجة لادراج آلاف الأسماء (عيّنه بسيطة تكفي)لأن الماكرو ديناميكي يأخذ كل الطلاب مهما كان عددهم الكود Option Explicit Dim i Dim arr(1 To 6) Dim Ws As Worksheet Dim New_sheet As Worksheet Dim Rg As Range, Spes_Rg As Range, x% '++++++++++++++++++++++++++++++++++++ Sub ADD_Sheet() Set Ws = Sheets("KOUSHOUFAT") arr(1) = "الأوّل": arr(2) = "الثّاني" arr(3) = "الثّالث": arr(4) = "الرّابع" arr(5) = "الخامس": arr(6) = "السّادس" For i = LBound(arr) To UBound(arr) If Not Application.Evaluate("ISREF('" & _ arr(i) & "'!A1)") Then Sheets.Add(, Sheets(Sheets.Count)).Name = arr(i) End If Next End Sub '++++++++++++++++++++++++++++++++++++ Sub Get_Studiantes() Application.ScreenUpdating = False ADD_Sheet Set Rg = Ws.Range("A1").CurrentRegion i = 1 For Each New_sheet In Sheets If New_sheet.Name <> Ws.Name Then New_sheet.Range("A1").CurrentRegion.Clear Rg.AutoFilter 3, arr(i) Rg.SpecialCells(12).Copy With New_sheet.Range("A1") .PasteSpecial (8) .PasteSpecial (12) .PasteSpecial (4) End With Set Spes_Rg = New_sheet.Range("A1").CurrentRegion x = Spes_Rg.Rows.Count If x > 1 Then Spes_Rg.Cells(2, 1).Resize(x - 1).Value = _ Evaluate("row(1:" & x - 1 & ")") End If i = i + 1 End If Next With Application .CutCopyMode = False .ScreenUpdating = True End With Ws.Select Ws.AutoFilterMode = False End Sub الملف مرفق jako.xlsm

😄 الله يسعدك استاذي وتاج راسي ظننت انها من بداياتك في هذا المنتدى 😍

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

حيا الله اخوي عبيد 🙂 الظاهر تلخبط عندك الجعافر 🙂 جعفر

السلام عليكم جرب الآن المرفق بعد تعديل بسيط في المعادلة... وتجدني إن شاء الله في الخدمة لتعديلات أخرى بعد التجربة... بن علية حاجي برنامج فحص (3).xlsx

ما فهمت في طلبك لو تقصد طباعة اي عدد من صفحة واحدة كل نسخة تحمل رقم فجرب المرفق Sub printTOUS() Dim x Dim printx printx = InputBox("ادخل اي عدد النسخ التي تريد طباعته") If printx = "" Then Exit Sub For x = 1 To printx Range("L6") = x Range("A1:L23").printOUT Next x Range("L6") = "" End Sub نموذج اكسيل لشيت اضافة.xlsm

السلام عليكم ورحمة الله جرب الملف المرفق لعل فيه ما تريد... بن علية حاجي برنامج فحص (3).xlsx

او بالامكان عمل نموذج لجلب الصور بهذه الطريقه مع اسم العميل

السلام عليكم ورحمة الله وبركاته الجامعات والكيات والمعاهد.xlsm

بشمهندسنا / عصام يبدو انك نسيت ان تضع المرفق

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

جزاك الله خيرا الحل هنا مش كده

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

يا اهلا بك يا دكتور اولا لا شكر على واجب وانا احب قدرى والحمد لله ويستبدل مكان هذا السطر Public Function DelDataAllTbl() Dim T As TableDef DoCmd.SetWarnings False For Each T In CurrentDb.TableDefs If T.Name <> "اسم الجدول" And T.Name <> "اسم الجدول" Then ' >>-----> اكتب هنا اسماء الجداول التى لا تريد حذف البيانات بداخلها If Not Left(T.Name, 4) = "MSys" Then DoCmd.RunSQL "DELETE * FROM [" & T.Name & "]" End If End If Next T DoCmd.SetWarnings True End Function تدلل يا دكتور

السلام عليكم ورحمة الله لم أراجع الموضوع من بدايته وردي هنا يخص المطلوب الأخير فقط (المعادلة في الخلية P32) إذا كنت قد فهمت المطلوب جيدا... أرجو أن يفي الغرض المطلوب... بن علية حاجي برنامج فحص (3).xlsx

عليكم السلام هذا الأمر لإظهار مربع خصائص الطابعة الافتراضية Shell "rundll32 printui.dll,PrintUIEntry /p /n""" & Printer.DeviceName & """", vbNormalFocus وهذا لإظهار مربع حوار الطباعة DoCmd.RunCommand acCmdPrint

تفضل اخوي العزيز .. تم التعديل =IFERROR(VLOOKUP($A3&$B3,CHOOSE({1,2},ALL!$A$4:$A$500&ALL!$B$4:$B$500,ALL!$F$4:$F$500),2,FALSE),"") قم بنسخ المعادلة .. وقم بتغيير حرف F الى العمود الذي تريده .. Copy of كانون اول 2020.xlsx

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

اعلى 3 في الرصيد .. Copy of البيانات.xlsm

تم معالجة الامر اذا صودف ان شحص او اكثر يملكون نفس الرصيد كما في حالة (شاديا حماد و بانة الرحال) يتم ادراج هذه الاشحاص) Ali_24.xlsm

الله ينور يا استاذنا ... نعم هذا الذي كنت احتاجه ... شكرا كثيرا لك .

طيب شوف كده PPPP (3).accdb

تفضل هذه المحاولة وهي استكمالا لحل استاذ obaid70 جزاه الله كل خير محجر-1.rar

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

احسن ناس وعلى الراس وبالعين

انا مكنتش فاهم انك تريد بدء الجمع من بداية 2020 هاهاهاهاهاهاهاهاهاهاهاا معلش صعيدى تسلم ايدك استاذ @husamwahab

السلام عليكم ورحمة الله ضعى هذا الكود فى حدث الفورم Private Sub CommandButton1_Click() Dim ws As Worksheet, LR As Long Set ws = Sheets("æÑÞÉ1") LR = ws.Range("J" & Rows.Count).End(3).Row + 1 If Not IsEmpty(Me.TextBox1.Value) Then ws.Cells(LR, "J") = Me.TextBox1.Value Me.TextBox1.Value = "" End If End Sub

لوحة مفاتيح OfficenaKeyboardUtility {V. 2 64 Bit}.mdb

ادة مهمة لا غنى عنها تحويل الحروف والارقام الى الترميز العالمى UNICODE وذلك لكتابة الرسائل داخل المحرر منعا لمشاكل اللغة العربية نهائيا والعكس طبعا لقرائتها كرة أخرى Converter Arabic and Unicode (v. 2).mdb

حيث انك عضو جديد يمكن تجربة هذا الملف لكن في المرة القادمة الملف ضروري monney.xlsm

السلام عليكم ورحمة الله وبركاته محاضرة اليوم عن بداية احتراف الدوال والمعادلات في الاكسل واكتشاف اخطاء المعادلة وحلها نتمنى أن يستفاد الجميع بها ان شاء الله لاتنسونا من دعائكم #we_love_mohammad_ﷺ_challenge #إلا_رسول_الله #إلا_حبيب_الله #رسولنا_خط_احمر #ماكرون_يسئ_للنبى #حبيبى_يا_رسول_الله #مقاطعة_المنتجات_الفرنسية

البرنامج يعمل اسم المستخدم- الدعم الفنى الباس ورد (1456)

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

اتفضل يا استاذ @Mostafa Elmahmoudy تفريبا ده طلب حضرتك 1293.Report_Draw_BoxLine.mdb

لا اعلم ما هي المشكلة لديك هل لنسخة اكسس دخل في ذلك ؟؟ فأنا اعمل على الاصدار 2003 ولا يمكنني فتح المرفق الأخير المثال عندي يعمل على اكمل وجه ، انظر الصور ( عند زيادة البيانات وحين تكون قليلة )