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

اعرف ان السؤال التالي سيكون ، وهل هناك طريقة علشان ما يكون هناك مسافات فارغة مكان الحقول المخفاة !! والجواب بعمل تقرير فرعي ، هكذا : . . جعفر 1159.1.Certificates.accdb.zip

فورم التنقل بين الشيتات مع البحث والاضافة والتعديل والحذف الفيديو

في الواقع ما كنت مرتاح من المسافات بين السنوات ، وخصوصا المسافات بين الدرجات ، فتوصلت الى التالي : التقرير rpt_4 مصدر بياناته هو الاستعلام qry_4 والذي هو نسخة من qry_3 ، ولكننا ننادي وحدة نمطية تختلف قليلا عن سابقتها ، فهنا نستعمل لغة HTML : 1. الاستعلام qry_4 ، ونرسل البيانات المطلوبة الى الوحدة النمطية Year_Report_HTML . 2. وهذه هي الوحدة النمطية : Public Function Year_Report_HTML(lbl_str As String, id As Long) As String On Error GoTo err_Year_Report_HTML 'On Error Resume Next DoCmd.DeleteObject acQuery, "NewQueryDef" On Error GoTo err_Year_Report_HTML Dim rst As DAO.Recordset Dim lbl, str, mySQL As String mySQL = "Select * From qry_1 Where [Table2_id]=" & id & " Order By Table2_id desc" Set rst = CurrentDb.OpenRecordset(mySQL) Do While Not rst.EOF 'lbl = lbl & rst!Yearr & " " '2 spaces 'str = str & " " & rst!Report & " " '1 space and 8 spaces lbl = lbl & "<font color=black>" & rst!Yearr & "</font><font color=white>" & ChrW(&H2588) & ChrW(&H2588) & "</font>" str = str & "<font color=white>" & ChrW(&H2588) & "</font><font color=black>" & rst!Report & "</font><font color=white>" & ChrW(&H2588) & ChrW(&H2588) & ChrW(&H2588) & "</font>" rst.MoveNext Loop If lbl_str = "lbl" Then Year_Report_HTML = lbl Else Year_Report_HTML = str End If Exit_Year_Report_HTML: rst.Close: Set rst = Nothing Exit Function err_Year_Report_HTML: If Err.Number = 3061 Then 'too few parameters, expected 1 or more 'this error occurs when trying to run a query which needs its parameters from a Form, 'the Form should be open with the parameter, then this code take the values properly Dim qdf As QueryDef Dim prm As Parameter Set qdf = CurrentDb.CreateQueryDef("NewQueryDef", mySQL) For Each prm In qdf.Parameters prm.Value = Eval(prm.Name) Next prm Set rst = qdf.OpenRecordset(dbOpenDynaset) DoCmd.DeleteObject acQuery, "NewQueryDef" Resume Next ElseIf Err.Number = 7874 Then 'could not find QueryDef Resume Next ElseIf Err.Number = 2486 Then 'could not delete QueryDef Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function . ونلاحظ اننا نعطلي لون اسود للسنوات والدرجات ، ولكننا نعطي اللون الابيض "للمسافة" ، يعني فقط اطبع هذا التقرير على ورق ابيض ، حتى لا ترى "المسافات" : . 3. الحقلين الذين في الاستعلام ، نراهم هنا . وهذه اعدادات الحقلين حتى يأخذوا لغة HTML . والنتيجة : . جعفر 1161.tt.accdb.zip

الملف الخاص بالعقد الذي ارفقته مكون من صفحين على العموم لا توجد مشكلة صفحتين او اربع او اكثر من خلال الوورد انسخ الصفحة الاولى والصقها في تقرير فارغ ثم قم بتنسيقة انظر الصورة المرفقة ثم قم بادراج فاصل صفحات ثم الصق صفحة رقم 2 بعد فاصل الصفحات من خلال نسخها من ملف الوورد ونسقها مثل الصفحة الاولى ومرفق ملفك ولكن لم استكمل اضافة باقي الحقول لا نشغالي اسم التقرير الجديد العقد عقد ايجار.accdb

نفع الله بك استاذنا @jjafferr دمتم بكل خير تحياتي

أ.AmirAdams جرب تغيير Dim rst As DAO.Recordset الى Dim Strdao As DAO.Recordset او ارفق مثال

أستاذ emam1424 لماذا انت دائما لا تقوم بالضغط على الإعجاب لكل الإجابات فى مشاركاتك ؟ !! 💙

برنامج للامانة لا اعرف من قام بتصميمه اضعه بين ايديكم للفائدة مثال للتعامل مع الصور.accdb

بارك الله فيك أستاذنا @عبد اللطيف سلوم وبارك الله في اخونا @د.كاف يار

الله يعطيك العافية اخي ابو اشرف واضح من الكتابة على الملف انه من اعداد اخونا الفاضل حسين كمال صاحب المعرف @د.كاف يار

وعليكم السلام 🙂 الاستعلام الضمني الذي عملته انت كمصدر بيانات للتقرير Table1 هو اساس العمل ، فأخذت نسخه منه وعملته كاستعلام مستقل اسمه qry_1 ، والذي به معايير السنوات 🙂 اصبح لدينا : 1. مصدر بيانات تقريرك Table1 هو الاستعلام qry_1 ، 2. جعلت الاستعلام qry_1 مصدر بيانات للاستعلام الجدولي qry_2 ، والاستعلام qry_2 مصدر بيانات التقرير rpt_2 ، 3. صحيح ان التقرير rpt_2 شغال تمام ، ولكنه يحتوي على السنوات (2017 و 2018 و 2019) التي تم استعمالها كمعيار للاستعلام qry_1 ، مما يعني ان التقرير يجب تعديله يدويا كلما تغيرت السنوات !! على هذا الاساس ، اشتغلت على الاستعلام qry_3 واللي مصدر بياناته qry_1 ، ولكني استعملت وحدة نمطية لتعطيني السنوات ، حقل للسنوات lbl (وندمج فيه جميع السنوات) وحقل للدرجة str (وندمج فيه جميع الدرجات) ، ونستعمل "المسافات" لنفرز المسافات بينها ، التقرير rpt_3 مصدر بياناته هو الاستعلام qry_3 . جعفر 1161.tt.accdb.zip

نفس الملف بواسطة الماكرو اذا كنت تريد الماكرو Option Explicit Sub Plus_num() Range("H2").Copy Range(Range("A2"), Range("A2").End(4)). _ PasteSpecial , Operation:=2 Application.CutCopyMode = False Range("A2").Select End Sub '+++++++++++++++++++++++++++++++++++++++++ Sub Minus_num() Range("J2").Copy Range(Range("A2"), Range("A2").End(4)). _ PasteSpecial , Operation:=3 Application.CutCopyMode = False Range("A2").Select End Sub aa.xlsm

السلام عليكم 🙂 استعمل هذا الكود في التقرير Documents1 : Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer) '1 If Me.annaul_1 = -1 Then Me.annaul_1.Visible = False: Me.based1.Visible = False: Me.rang1.Visible = False: Me.rang2.Visible = False Else Me.annaul_1.Visible = True: Me.based1.Visible = True: Me.rang1.Visible = True: Me.rang2.Visible = True End If '2 If Me.annaul_2 = -1 Then Me.annaul_2.Visible = False: Me.based2.Visible = False: Me.rang3.Visible = False: Me.rang4.Visible = False Else Me.annaul_2.Visible = True: Me.based2.Visible = True: Me.rang3.Visible = True: Me.rang4.Visible = True End If '3 If Me.annual_3 = -1 Then Me.annual_3.Visible = False: Me.based3.Visible = False: Me.rang5.Visible = False: Me.rang6.Visible = False Else Me.annual_3.Visible = True: Me.based3.Visible = True: Me.rang5.Visible = True: Me.rang6.Visible = True End If '4 If Me.annual_4 = -1 Then Me.annual_4.Visible = False: Me.based4.Visible = False: Me.rang7.Visible = False: Me.rang8.Visible = False Else Me.annual_4.Visible = True: Me.based4.Visible = True: Me.rang7.Visible = True: Me.rang8.Visible = True End If '5 If Me.annual_5 = -1 Then Me.annual_5.Visible = False: Me.based5.Visible = False: Me.rang9.Visible = False: Me.rang10.Visible = False Else Me.annual_5.Visible = True: Me.based5.Visible = True: Me.rang9.Visible = True: Me.rang10.Visible = True End If '6 If Me.annual_6 = -1 Then Me.annual_6.Visible = False: Me.till.Visible = False: Me.rang11.Visible = False: Me.rang12.Visible = False Else Me.annual_6.Visible = True: Me.till.Visible = True: Me.rang11.Visible = True: Me.rang12.Visible = True End If End Sub . كما ان الاستعلام مصدر بيانات التقرير يجب ان يُصبح: . فيصبح التقرير: . جعفر 1159.Certificates.accdb.zip

السلام عليكم تم تحويل معادلة الاستاذ يوسف الى كود ويتعامل الى 1000صف .يمكنك الزيادة في الكود بدل 1000 الى الرقم الذي تريده لاننسي صاحب الكود من دعوة صالحة بان يجعلها في ميزان حسناته السيد الفاضل عبدالله باقشير جرب الملف _QTesT1.xlsm

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

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

هل هذا ما تقصده ؟ مربع تحرير وسرد.rar

شكر الله لك أستاذ سليم .. وجزاك خيرا .. رائع جدا جدا جدا

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

تم التصحيح مرة اخرى profabs_new1.xlsm

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

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

وعليكم السلام ورحمة الله وبركاته انظر استعلام q1 وتقرير rep1 ارجو ان يكون هو المطلوب tt.rar تحياتي

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

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

السلام عليكم انظر للملف المرفق اخي الكريم وحسب ماطلبت اعلمنا ملاحظاتك تحياتي test.rar

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

مبروك استاذ احمد

هو هذا ما يفعله الكود الرقم الوظيفي اذا تكرر يتم ادراجه مرة واحدة فقط

وعليكم السلام ممكن عملها باكثر من طريقة الطريقة الاولى في المرفق في النموذج المسمى table تم عملها بدون استخدام اكواد عن طريق منشئ التعبير مع الاستعانة بمربعات نص غير منظمة ووضع تعبير مشروط اذا كانت خانة الاختيار =-1 تكون قيمة مربع النص تساوي القيمة الفعلية للحقل واذا كانت خانة الاختيار غير مؤشر عليها "صفر" تكون قيمة الحقل الغير منظم تساوي صفر وهكذا لبقية الحقول ثم جمعنا مربعات النص الغير منظمة للحصول على النتيجة الطريقة الثانية في النموذج المسمى جدول1 عملنا زر امر عند النقر يقوم بحجز متغيرات واستخدمنا كود بواسطة دالة IIF وبنفس الفكرة السابقة ولكن بدلا من مربعات النص غير المنظمة استخدمنا المتغيرات ممكن عملها بطريقة اخرى ولكن في اعتقاد هذة اسهل الطرق للحصول على النتيجة والله اعلم aa.accdb

وعليكم السلام-مشاركة بالتأكيد ناقصة البيانات فكيف يتم تجربة المعادلة بملف فارغ وخالى تماما من البيانات لابد من وضع على الأقل 5 صفوف فى كل شهر لإختبار عمل المعادلة فلا يمكن العمل على ملف خالى من البيانات !!!!! فبما انك لم تقم برفع بيانات بالملف فيمكنك تجربة هذا الكود فلا يمكن عمل المطلوب أفضل الا بكود وليس معادلة فهذا بدوره يثقل من عمل الملف عند استخدام المعادلة Sub Combine() Dim I As Long Dim xRg As Range On Error Resume Next Worksheets.Add Sheets(1) ActiveSheet.Name = "Combined" For I = 2 To Sheets.Count Set xRg = Sheets(1).UsedRange If I > 2 Then Set xRg = Sheets(1).Cells(xRg.Rows.Count + 1, 1) End If Sheets(I).Activate ActiveSheet.UsedRange.Copy xRg Next End Sub وهذا فيديو لعمل وشرح معادلة لما تريد تجميع بيانات مجموعة صفحات بصفحة واحدة بشكل مباشر

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

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

السلام عليكم الخطأ في رقم العمود بدل 116 اصبح117 المصنف1.xlsb

مبارك استاذ احمد فعلا يستحق

السلام عليكم 🙂 مع ان هذا الخيار ممكن استعماله ، ولكن ، للأسف الشديد ، هناك الكثير من المبرمجين يستعملون حقل الترقيم التلقائي كأحد الحقول التي يعتمد عليها البرنامج في التسلسل/الترقيم ، ومرتبط بجداول اخرى ، بينما يجب ان يكون حقل الترقيم التلقائي لإستخدام البرنامج (للفهرسة والوصول للسجلات) وليس لاستخدام المبرمج (لإستعماله في تسلسل/ترقيم الارقام او العملاء) . وعليه ، فإذا كان البرنامج يستعمل هذا النوع ، فإن حقل الترقيم التلقائي لن يحتفظ بالارقام الاصلية في البرنامج ، واستعلام الالحاق سيخلق ترقيم جديد ، مما سيجعل البرنامج لا يقوم بعمله بصورة صحيحة !! جعفر

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

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

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

ممكن توضيح اخي القاضي هل قاعدة البيانات محذوفة وتريد استراجعها أم انك نسيت الباسورد؟ ماهي صيغة الملف ؟ اذا لم تكن محذوفة هل القاعدة حاليا مرتبطه بالواجهة أم لا ::بالتوفيق::

الف مبروك على الانضمام الى الفريق بالتوفيق

السلام عليكم اخي العزيز ماقي مشكلة ليس لها حل ان شاء الله تفضل اخي الكريم طلبك : 1-البرنامج يحسب لك تاريخ استحقاق العلاوة الجديدة بصورة تلقائية لمدة سنة واحدة عند ادخال تاريخ العلاوة السابق. 2- عند وجود شكر للموظف يتم اختياره من القائمة المنسدلة ويقوم البرنامج بتقديم تاريخ استحقاق العلاوة الجديده لمدة شهر واحد. 3- اقصى حد للتشكرات التي تقوم بتقديم تاريخ العلاوة السنوية هو (3) . 4- عملت لك رسالة تنبيه باللون الاحمر (وميض متحرك) نعمل قبل 5 ايام من تاريخ الاستحقاق الجديد ويمكن زيادة مدة التنبيه الى اكثر من ذلك. 5- عملت لك تقرير بالعلاوات السنوية / في حالة وجود اي علاوة بقتح التقرير بصورة طبيعية / وفي حالة عدم وجود اي علاوة تظهر لك رسالة / لاتوجد علاوات هذا اليوم. اعلمنا النتائج ؟؟؟؟؟ تحياتي test.rar

جرب هذه المعادلة =IF(A2="","",CHOOSE((COUNTIF($L$2:$L$50,A2)>0)+1,"عام","خاص")) الملف مرفق count+ cHOOSE.xlsx

الف مبروك استاذنا احمد بدره بالتوفيق والنجاح ان شاء الله فى تالق دائم

تفضل ... Database1.accdb

اهلا بك فى المنتدى -يمكنك استخدام هذه المعادلة =IF(COUNTIFS(Sheet1!$N:$N,$A2,Sheet1!$R:$R,$E2)>=1,"مدرج","غير مدرج") ملف مقارنه الاصناف مع الفاتوره1.xlsx

Sub test() Dim a As Variant, lr, i, x, s, k, itm Dim bch As Worksheet Set bch = Sheets("Bank Cheque") lr = bch.Cells(Rows.Count, "a").End(xlUp).Row - 1 a = Application.Index(bch.Cells(2, 2).Resize(lr, 21).Value, Application.Evaluate("row(1:" & lr & ")"), Array(1, 2, 6, 7, 8, 13, 16, 20)) With CreateObject("scripting.dictionary") For i = 1 To UBound(a) If bch.Cells(i + 1, 4) = Sheets("Sheet4").Range("d3") And bch.Cells(i, 4) <> "" Then If Not .exists(Cells(i + 1, 4)) Then .Add bch.Cells(i + 1, 4), a(i, 1) & Chr(162) & a(i, 2) & Chr(162) & a(i, 3) & Chr(162) & a(i, 4) & Chr(162) & a(i, 5) & Chr(162) & a(i, 6) & Chr(162) & a(i, 7) & Chr(162) & a(i, 8) Else .Item(bch.Cells(i + 1, 4)) = .Item(Cells(i + 1, 4)) & Chr(162) & a(i, 1) & Chr(162) & a(i, 2) & Chr(162) & a(i, 3) & Chr(162) & a(i, 4) & Chr(162) & a(i, 5) & Chr(162) & a(i, 6) & Chr(162) & a(i, 7) & Chr(162) & a(i, 8) End If End If Next k = .keys itm = .items Ct = .Count With Sheets("Sheet4") Range("a8:f10000").ClearContents For i = 1 To Ct x = Split(itm(i - 1), Chr(162)) .Range("a" & 8 + i - 1).Resize(, UBound(x) + 1) = x Next End With End With End Sub اسم الشركة فيD3

وبعد اذن جميع الأساتذة وزيادة فى اثراء الموضوع-تفضل Bank Cheque.xlsm

اتبعع الخطوات

احتجت لتحويل عدد كبير من القوائم الي فقرات ، فقما باعداد هذا الكود ليحول القائمة الي فقرات بدمج الاسظر ووضع فاصلية بين المحتويات.، و لتفعيله اختار محتويات القائمة ثم شغل الكود. و هو يصلح لاي نوع من القوائم فى الوورد سواء كانت مرقمة او تبدأ باحدى علامات النقاط ، Numbered Lists , or Bullet points فسيقوم القوم بدمجها فى فقرة واحدة و اضافة فصلة بينها و هذا الأمر مفيد فى الأبحاث العلمية ، حيث هناك جانب كبير من المختصين لا يحبذ الإكثار من استخدام الفوائم فى كتابات البحث العلمي ، مثل الأوراق البحثية أو الرسائل العلمية. و ان كنت أرى ان القوائم اوضح كثيرا من الفقرات 😊 Sub ReplaceLineBreak() With Selection.Find .Text = "^p" 'replace with comma .Replacement.Text = ", " .Forward = True .Wrap = wdFindStop .Format = False .MatchCase = False .MatchWholeWord = False .MatchKashida = False .MatchDiacritics = False .MatchAlefHamza = False .MatchControl = False .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = False End With Selection.Find.Execute Replace:=wdReplaceAll End Sub