بحث مخصص من جوجل فى أوفيسنا
![]()
Custom Search
|
نجوم المشاركات
Popular Content
Showing content with the highest reputation on 12/24/19 in مشاركات
-
4 points
-
فورم التنقل بين الشيتات مع البحث والاضافة والتعديل والحذف الفيديو2 points
-
في الواقع ما كنت مرتاح من المسافات بين السنوات ، وخصوصا المسافات بين الدرجات ، فتوصلت الى التالي : التقرير 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.zip2 points
-
الملف الخاص بالعقد الذي ارفقته مكون من صفحين على العموم لا توجد مشكلة صفحتين او اربع او اكثر من خلال الوورد انسخ الصفحة الاولى والصقها في تقرير فارغ ثم قم بتنسيقة انظر الصورة المرفقة ثم قم بادراج فاصل صفحات ثم الصق صفحة رقم 2 بعد فاصل الصفحات من خلال نسخها من ملف الوورد ونسقها مثل الصفحة الاولى ومرفق ملفك ولكن لم استكمل اضافة باقي الحقول لا نشغالي اسم التقرير الجديد العقد عقد ايجار.accdb2 points
-
2 points
-
أ.AmirAdams جرب تغيير Dim rst As DAO.Recordset الى Dim Strdao As DAO.Recordset او ارفق مثال2 points
-
أستاذ emam1424 لماذا انت دائما لا تقوم بالضغط على الإعجاب لكل الإجابات فى مشاركاتك ؟ !! 💙2 points
-
2 points
-
بارك الله فيك أستاذنا @عبد اللطيف سلوم وبارك الله في اخونا @د.كاف يار2 points
-
2 points
-
وعليكم السلام 🙂 الاستعلام الضمني الذي عملته انت كمصدر بيانات للتقرير 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.zip2 points
-
نفس الملف بواسطة الماكرو اذا كنت تريد الماكرو 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.xlsm2 points
-
السلام عليكم 🙂 استعمل هذا الكود في التقرير 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.zip2 points
-
السلام عليكم تم تحويل معادلة الاستاذ يوسف الى كود ويتعامل الى 1000صف .يمكنك الزيادة في الكود بدل 1000 الى الرقم الذي تريده لاننسي صاحب الكود من دعوة صالحة بان يجعلها في ميزان حسناته السيد الفاضل عبدالله باقشير جرب الملف _QTesT1.xlsm2 points
-
1 point
-
1 point
-
1 point
-
1 point
-
1 point
-
و لكن لماذا عندما اضغط على الاسم . يمحو البياناات. في الجدول.؟؟؟ هذا لأنه اذا ضغطت على الاسم مرة ثانية يفهم الاكسل انك تريد ان تعدل بالبيانات لهذا الاسم لذلك يمحوها لك بانتظار ادخال بيانات جديدة عن نفس الاسم1 point
-
تم التصحيح مرة اخرى profabs_new1.xlsm1 point
-
السلام عليكم الله يجعله في ميزان حسناتكم وجزاكم الله خير مشكورررين كثير ي اساتذه الله يزيدكم من فضله واتمنى لكم التوفيق1 point
-
استاذنا جعفر الليه ينور على حضرتك ما شاء الله تبارك الله ربنا يجعل دعواتنا في ميزان حسناتك والله اللسان يعجز عن الشكر ربنا يجعل ايامك كلها خير ويسدد خطاك دايما الف مليون شكر1 point
-
الف مبروك استاذ احمد بدرة بالفعل انت مستحق كل الخير واتمنى لك الموفقية الدائمة1 point
-
وعليكم السلام ورحمة الله وبركاته انظر استعلام q1 وتقرير rep1 ارجو ان يكون هو المطلوب tt.rar تحياتي1 point
-
السلام عليكم تفضل أخي الكريم التعديل على مرفقك الارتباط بالقاعدة.rar1 point
-
وعليكم السلام- طالما ان الملف ليس به اى فورم فعليك عمل ذلك بنفسك واذا تعسرت فى جزئية فعليك برفعها هنا -فالمنتدى تعليمى من المقام الأول وليس لتقديم البرامج الجاهزة فمن فضلك عليك بإستخدام خاصية البحث بالمنتدى فبه مئات المشاركات التى تخص طلبك1 point
-
بعد اذن الاخوه الاعزاء تعتبر الحماية برقم البارتشن غير مجدية في حالة القيام بفرمتة بارتشن C والافضل الحماية بالسريال نمبر الحقيقي للهارد ديسك سوف ابحث في ملفاتي عن كود استخراج سريال نمبر الحقيقي للهارد ديسك واذا وجدته سأضعه هنا ليستفيد الجميع منه ولي موضوع قديم بهذا الصدد بالمنتدي ولكن لا اتذكر الرابط او العنوان1 point
-
الشكر لله اخى ولاساتذتنا الافاضل بارك الله فيك اخى ربنا يوفقك طبتم واهتديتم1 point
-
1 point
-
1 point
-
وعليكم السلام ممكن عملها باكثر من طريقة الطريقة الاولى في المرفق في النموذج المسمى table تم عملها بدون استخدام اكواد عن طريق منشئ التعبير مع الاستعانة بمربعات نص غير منظمة ووضع تعبير مشروط اذا كانت خانة الاختيار =-1 تكون قيمة مربع النص تساوي القيمة الفعلية للحقل واذا كانت خانة الاختيار غير مؤشر عليها "صفر" تكون قيمة الحقل الغير منظم تساوي صفر وهكذا لبقية الحقول ثم جمعنا مربعات النص الغير منظمة للحصول على النتيجة الطريقة الثانية في النموذج المسمى جدول1 عملنا زر امر عند النقر يقوم بحجز متغيرات واستخدمنا كود بواسطة دالة IIF وبنفس الفكرة السابقة ولكن بدلا من مربعات النص غير المنظمة استخدمنا المتغيرات ممكن عملها بطريقة اخرى ولكن في اعتقاد هذة اسهل الطرق للحصول على النتيجة والله اعلم aa.accdb1 point
-
وعليكم السلام-مشاركة بالتأكيد ناقصة البيانات فكيف يتم تجربة المعادلة بملف فارغ وخالى تماما من البيانات لابد من وضع على الأقل 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 وهذا فيديو لعمل وشرح معادلة لما تريد تجميع بيانات مجموعة صفحات بصفحة واحدة بشكل مباشر1 point
-
اخوانى الافاضل بارك الله فيكم وبعتذر جدا على عدم فهمى للرد اعذرا استاذ احمد تم حل الامر الحمد لله بارك الله فيكم على الاهتمام1 point
-
الف مبروك استاذ احمد بدرة انت جدير بهذه المسؤولية لما تقدمه من عطاء في الاونة الاخيرة وحرصك على حل مشاكل جميع الاعضاء بدون كلل او ملل موفق ومن نجاح الى اخر .1 point
-
1 point
-
تفضل متابعة الائتمان 2.rar هذا المديول تستطيع المناداة عليه من النموذج الرئيسي HideAccess اخفاء اكسس.accdb1 point
-
1 point
-
السلام عليكم 🙂 مع ان هذا الخيار ممكن استعماله ، ولكن ، للأسف الشديد ، هناك الكثير من المبرمجين يستعملون حقل الترقيم التلقائي كأحد الحقول التي يعتمد عليها البرنامج في التسلسل/الترقيم ، ومرتبط بجداول اخرى ، بينما يجب ان يكون حقل الترقيم التلقائي لإستخدام البرنامج (للفهرسة والوصول للسجلات) وليس لاستخدام المبرمج (لإستعماله في تسلسل/ترقيم الارقام او العملاء) . وعليه ، فإذا كان البرنامج يستعمل هذا النوع ، فإن حقل الترقيم التلقائي لن يحتفظ بالارقام الاصلية في البرنامج ، واستعلام الالحاق سيخلق ترقيم جديد ، مما سيجعل البرنامج لا يقوم بعمله بصورة صحيحة !! جعفر1 point
-
اسهل حل هو حذف قاعدة البيانات الخلفية السابقة و وضع النسخه الاحتياطية مكانها مع إعادة تسميتها بنفس الاسم ونفس الباسورد الحل الثاني حذف الجداول من القاعدة الخلفية واستيرادها من القاعدة الاحتياطية الحل الثالث عمل استعلام الحاق في القاعدة الاحتياطية واختيار جدول الوجهة من قاعدة أخرى واختيار القاعدة الخلفية ::بالتوفيق::1 point
-
السلام عليكم ورحمة الله الف الف مبروك عن جدارة و استحقاق1 point
-
المشكلة لديك أخي في خصائص الحقل لديك عبارة عن نص طويل .... يعني مذكرة ... وفي هذه الحالة لايمكن بناء علاقة في كائن مذكرة ...... يجب تحويل خصائص النص وخاصة في حقل الربط وهو الرقم الاكاديمي للطالب الى نص مختصر في الجدولين .....1 point
-
1 point
-
1 point
-
السلام عليكم اخي العزيز ماقي مشكلة ليس لها حل ان شاء الله تفضل اخي الكريم طلبك : 1-البرنامج يحسب لك تاريخ استحقاق العلاوة الجديدة بصورة تلقائية لمدة سنة واحدة عند ادخال تاريخ العلاوة السابق. 2- عند وجود شكر للموظف يتم اختياره من القائمة المنسدلة ويقوم البرنامج بتقديم تاريخ استحقاق العلاوة الجديده لمدة شهر واحد. 3- اقصى حد للتشكرات التي تقوم بتقديم تاريخ العلاوة السنوية هو (3) . 4- عملت لك رسالة تنبيه باللون الاحمر (وميض متحرك) نعمل قبل 5 ايام من تاريخ الاستحقاق الجديد ويمكن زيادة مدة التنبيه الى اكثر من ذلك. 5- عملت لك تقرير بالعلاوات السنوية / في حالة وجود اي علاوة بقتح التقرير بصورة طبيعية / وفي حالة عدم وجود اي علاوة تظهر لك رسالة / لاتوجد علاوات هذا اليوم. اعلمنا النتائج ؟؟؟؟؟ تحياتي test.rar1 point
-
الف مبروك استاذنا احمد بدره بالتوفيق والنجاح ان شاء الله فى تالق دائم1 point
-
1 point
-
1 point
-
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 اسم الشركة فيD31 point
-
احتجت لتحويل عدد كبير من القوائم الي فقرات ، فقما باعداد هذا الكود ليحول القائمة الي فقرات بدمج الاسظر ووضع فاصلية بين المحتويات.، و لتفعيله اختار محتويات القائمة ثم شغل الكود. و هو يصلح لاي نوع من القوائم فى الوورد سواء كانت مرقمة او تبدأ باحدى علامات النقاط ، 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 Sub1 point