اذهب الي المحتوي
أوفيسنا

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

  1. أ / محمد صالح

    أ / محمد صالح

    أوفيسنا


    • نقاط

      17

    • Posts

      4,357


  2. متقاعد

    متقاعد

    الخبراء


    • نقاط

      10

    • Posts

      583


  3. Moosak

    Moosak

    أوفيسنا


    • نقاط

      7

    • Posts

      1,823


  4. Eng.Qassim

    Eng.Qassim

    الخبراء


    • نقاط

      6

    • Posts

      2,275


Popular Content

Showing content with the highest reputation on 26 يون, 2022 in all areas

  1. السؤال مبهم قليلا ولكن وفق فهمي للسؤال لديك تقرير اذا فتح التقرير من نموذج ا يكون اسم التقرير تقرير 1 مثلا ومصدر بياناته الجدول aa واذا فتحناه من نموذج ب يكون اسم التقرير تقرير 2 ومصدره استعلام 1 مثلا اذا كان فهمي صحيح ممكن استخدام البارامتر السادس في امر فتح التقرير حيث ان امر فتح يحتوي على سته معلمات بالترتيب ReportName View FilterName WhereCondition WindowMode OpenArgs والسادس هو مايهمنا والفكر ارسال قيمة محددة مع امر الفتح على سبيل المثال DoCmd.OpenReport "companies", acViewPreview, , , , 1 او هكذا DoCmd.OpenReport "companies", acViewPreview, OpenArgs:=1 وفي امر فتح للتقرير If Me.OpenArgs = 1 Then Me.Report.Caption = "test" Me.Report.RecordSource = "q_1" Else Me.Report.Caption = "kh" Me.Report.RecordSource = "companies" End If
    5 points
  2. تفضل اخي الكريم .... المثال لكود اخي @مبرمج سابق Info list.rar
    3 points
  3. في مصدر بيانات مربع النص ضع هذا =DSum("[Odb_Qty]";"[Odb_PlaningMonthe_ForCost_ProdactionSUM]";"[Odb_Type] Like 'برميل'") وغير لبقية مربعات النص جالون كرتون بالمناسبة هذه الاداة مفيدة جدددددددددددددددددددددددددددا وشكرا لصانعها وبارك فيه
    3 points
  4. ترى كلنا نحب الصعايدة والنعم فيهم .... اسمح لي استخدم مثالك بطريقة اخرى للفائدة واثراء الموضوع باستخدم هذا الكود .... Dim db As DAO.Database Dim qdf As DAO.QueryDef Dim strSQL1 As String, strSQL2 As String Set db = CurrentDb db.QueryDefs.Delete "qr1" If com1 = "التقرير الاول" Then strSQL1 = "SELECT tblA.ID, tblA.fld FROM tblA;" Set qdf = db.CreateQueryDef("qr1", strSQL1) ElseIf com1 = "التقرير الثاني" Then strSQL2 = "SELECT tblB.ID, tblB.fld FROM tblB;" Set qdf = db.CreateQueryDef("qr1", strSQL2) End If DoCmd.OpenReport "rptFlayReport", acViewPreview وهذا المثال ..... Chang Record Sources Report.mdb
    2 points
  5. طيب ممكن تجربة المرفق الاتى لانه يبدو لى ان التقرير نريده ان يقتح على اكثر من مصدر بيانات حسب الحالة ان لم افهم الموضوع جيدا برجاء مرفق حتى اسطيع الفهم >>---> صعيدى بيفهم بالعافية Chang Record Sources Report.mdb
    2 points
  6. " إذا عُرِفَ السبب بطل العجب " أول ما تبادر لذهني بعد قرائتي للموضوع : ما الهدف من ذلك ؟ والجواب عن هذا السؤال هو ما سيفتح لنا باب الحل المناسب🙂
    2 points
  7. والله ياعم قاسم انا فهمي على قدي اذا اردنا متغيير عام نضع الامر التالي في بداية اي وحدة نمطية Public x As String ثم في امر فتح نضع x = "اسم التقرير" DoCmd.OpenReport x, acViewPreview
    2 points
  8. ولماذا حذفت الكود كله؟ يمكنك الاستفادة من هذا الموضوع في تشغيل الساعة مع القدرة على العمل في الملف بصورة طبيعية بالتوفيق
    2 points
  9. شكرا جزيلا لك أخي @kanory 🙂🌷🌸 سعيد جدا أنك استفدت منها 😊🌹
    2 points
  10. طيب :::: خلينا نفهم انت كيف بتدخل هذه الارقام هل هناك نموذج لذلك ؟؟؟ اذا كانت الاجابة نعم .... 1- نحتاج ان نربط بين جدول هذه البيانات ( الغياب والحضور والقيد ) وجدول الامتحان ........ على الاقل وقت ادخال تلك البيانات 2- نحتاج نضيف حقول في جدول الغياب لليوم والتاريخ والفترة والمادة أو نختصرها بـ ID خاص في جدول الامتحان وهذا الرقم يضاف عند تسجيل البيانات في جدول الغياب 3- الخطوة الاخيرة استعلام للحقول التي نحتاجها في التقرير ....
    2 points
  11. السلام عليكم ورحمة الله وبركاتة برجاء مساعدتي في : لدي نموذج رئيسي ونموذج فرعي لادخال الاصناف في النموذج الفرعي يتم ادخال به كل الاصناف الوارده اريد ان يجمع لي اسفل النموذج الفرعي كمية الكرتون لحاله وكمية البرميل لحاله وكمية الجالون لحاله كما هو مذكور بالمرفق ولكم جزيل الشكر FGH.rar
    1 point
  12. والصعايدة غالية علية 😂 يا سلاااام ...دة انا اموت في الصعايدة
    1 point
  13. خدعتني هذه الجملة .. ولم اكلف نفسي بتتبع الكود 🤣
    1 point
  14. شكرا للكلماتك الطيبة في properties الخاص بها غير value إلى true
    1 point
  15. نعم احسنت اخي قاسم الحقيقة ان الموضوع فعلا يحتاج ايضاح كما اشار مستر @Moosak على كل حال كمداخلة اخيرة الى ان تتضح الامور للاخوة نحتاج احيان الى اعادة تسمية كائن في قاعدة البيانات سواء كان جدول او استعلام او فورم او تقرير او وحدة نمطية ونرغب ان يتم التغيير عن طريق الكود DoCmd.Rename "r_2", acReport, "companies" في هذا الامر لدينا ثلاث معلمات NewName هنا يساوي r_2 ObjectType وهو نوع الكائن و هنا تقرير " بعض قدامي المبرمجين بدلا من تحديد نوع الكائن يضع القيمة للكائن وهنا رقم 3 " OldName وهو اسم التقرير القديم companies تحياتي ولنا لقاء في موضوع اخر
    1 point
  16. تفضل __سجل المدرسة2022.xls
    1 point
  17. The last point is not clear for me Sub Test() Const sSheetName As String = "Report" Dim e, ws As Worksheet, f As Boolean, t1 As Double, t2 As Double, x As Long, y As Long, r As Long, iRow As Long, fRow As Long Application.ScreenUpdating = False Set ws = ThisWorkbook.Worksheets("MIN") On Error Resume Next Application.DisplayAlerts = False ThisWorkbook.Worksheets(sSheetName).Delete Application.DisplayAlerts = True On Error GoTo 0 Sheets.Add(After:=Sheets(Sheets.Count)).Name = sSheetName With ThisWorkbook.Worksheets(sSheetName) .DisplayRightToLeft = True .Cells.Clear With .Cells .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With iRow = 1 For y = 2012 To Year(Date) fRow = iRow t1 = 0: t2 = 0: x = 0 ws.Range("C14").Value = y With .Cells(iRow, 1) .Value = y .Font.Bold = True .Interior.Color = RGB(219, 219, 219) End With For Each e In Array("16|30", "32|41", "43|52") x = x + 1 f = False For r = Val(Split(e, "|")(0)) To Val(Split(e, "|")(1)) If ws.Cells(r, "U").Value > 0 And ws.Cells(r, "U").Value <> Empty Then If f = False Then iRow = iRow + 1 If x = 2 Then iRow = iRow + 1 .Cells(iRow, 2).Value = ws.Range(IIf(x = 1, "D", "B") & Val(Split(e, "|")(0)) - 1).Value .Cells(iRow, 3).Resize(, 6).Value = ws.Range("P" & Val(Split(e, "|")(0)) - 1).Resize(, 6).Value .Cells(iRow, 2).Resize(, 7).Interior.Color = vbYellow f = True End If iRow = iRow + 1 .Cells(iRow, 2).Value = ws.Cells(r, IIf(x = 1, "D", "B")).Value .Cells(iRow, 3).Resize(, 6).Value = ws.Cells(r, "P").Resize(, 6).Value t1 = t1 + .Cells(iRow, "F").Value t2 = t2 + .Cells(iRow, "H").Value End If Next r iRow = iRow + 1 If x = 1 Then iRow = iRow - 1 Next e iRow = iRow + 1 .Cells(iRow, 2).Value = "Total" With .Cells(iRow, "F") .Value = t1 .Interior.Color = vbCyan End With With .Cells(iRow, "H") .Value = t2 .Interior.Color = vbCyan End With iRow = iRow + 2 With .Range(.Cells(fRow, 2), .Cells(iRow - 2, 8)) .Borders.Value = 1 .BorderAround Weight:=3 End With f = False Next y .Rows.RowHeight = 19 .Columns(1).ColumnWidth = 9 For Each e In Array(3, 5, 6, 8) .Columns(e).NumberFormat = "0.00" Next e .Columns(7).NumberFormat = "0%" .Columns("B:H").AutoFit End With Application.ScreenUpdating = True End Sub
    1 point
  18. الموضوع كما قلت حضرتك بسيط جدا ولا يحتاج استيراد ولا تصدير ولا معادلات فقط تقوم بتصفية filter الاسم المطلوب ثم طباعة على طابعة الويندوز pdf أو استعمال كود تصدير الشيت النشط إلى pdf ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "/" & Filename & ".pdf", , , False بالتوفيق
    1 point
  19. منطقيا حضرتك لا تحتاج لمعادلة في هذه الحالة فصاحبا هذين الصفين لهما اسمان وكل لجانهما احتياطي لذا يلزمك كتابة اسمهما أسفل الاسمين الاحتياطي يدويا أو بمعادلة بسيطة مثل =sheet1!$c17 =sheet1!$c32 مع سحب المعادلة أفقيا بالتوفيق
    1 point
  20. اولا انشئ جدول باسم tblHolidays يتكون هذا الجدول من حقلين الحقل الاول باسم HolidayType نوع الحقل نصى ليحتوى على اسم او وصف الأعياد والأجازات الرسمية لهذا العام الحقل الثانى باسم HolidayDate نوع الحقل تاريخ ليحتوى على تاريخ الأعياد والأجازات الرسمية لهذا العام بعد ذلك انشئ وحدة نمطية وضع بها الروتين الاتى Function ActualDays(ByVal dtStartDay As Date, ByVal dtEndDay As Date, Optional nDay As Integer = 0) As Long Dim dtNominalEndDay As Date Dim lngTotalDays As Long Dim lngTotalWeeks As Long Dim lngTotalHolidays As Long Dim lngstart As Long Dim lngend As Long 'Check to see if dtStartDay > dtEndDay. If so, then switch the dates If dtStartDay > dtEndDay Then ActualDays = 0: Exit Function ' If dtStartDay >= dtEndDay Then ' dtNominalEndDay = dtStartDay ' dtStartDay = dtEndDay ' dtEndDay = dtNominalEndDay ' End If 'Here are how many weeks are between the two dates lngTotalWeeks = DateDiff("w", dtStartDay, dtEndDay) 'Here are the number of weekdays in that total week lngTotalDays = lngTotalWeeks * 5 'Here is the date that is at the end of that many weeks dtNominalEndDay = DateAdd("d", (lngTotalWeeks * 7), dtStartDay) 'Now add the number of weekdays between the nominal end day and the actual end day While dtNominalEndDay <= dtEndDay If Weekday(dtNominalEndDay, 2) <> 5 Then If Weekday(dtNominalEndDay, 2) <> 6 Then lngTotalDays = lngTotalDays + 1 End If End If dtNominalEndDay = dtNominalEndDay + 1 Wend 'convert end date and startdate into long integer format for the DCount operation to avoid misreading of dates as US format lngstart = dtStartDay lngend = dtEndDay 'Here are how many holiday days there are between the two days lngTotalHolidays = DCount("HolidayDate", "tblHolidays", "HolidayDate <= " & lngend & " AND HolidayDate >= " & lngstart & " AND Weekday(HolidayDate,2) <> 6 AND Weekday(HolidayDate,2) <> 5") ActualDays = lngTotalDays - lngTotalHolidays 'Here are how many holidays between the two dates plus the number of weekends 'If nDay = 1 Then ActualDays = DateDiff("d", dtStartDay, dtEndDay) - ActualDays + 1 If nDay = 1 Then ActualDays = DateDiff("d", dtStartDay, dtEndDay) + 1 If nDay = 2 Then ActualDays = DateDiff("d", dtStartDay, dtEndDay) - ActualDays + 1 If nDay = 3 Then ActualDays = lngTotalHolidays If nDay = 4 Then ActualDays = (DateDiff("d", dtStartDay, dtEndDay) - ActualDays + 1) - lngTotalHolidays End Function ولاستدعاء الروتين السابق لاحتساب الايام الفعلية بين تاريخين بدون العطل الرسيمة داخل الجدول المحدد لذلك وبدون ايام الجمعة والسبت ActualDays([BeginDate],[EndDate]) وان اردت استخلاص عدد العطلات الرسمية بين تاريخين والتى تم تحديدها مسبقا بجدول tblHolidays + العطلات الاسبوعية ( الجمعة + السبت ) قم ياستدعاء الروتين بالشكل الاتى ActualDays([BeginDate],[EndDate],1) وهذا التعديل الاخير لى على الأكود فى المرفق الذى اشار اليه الباش مهندس @Moosak تم تعديل المرفق ActualDaysCalcult.accdb
    1 point
  21. ههههه والله انا فهمت هيك...على كل حال زيادة في المعلومات واثراء الموضوع
    1 point
  22. وعليكم السلام هذه الدالة من موقع مايكروسوفت ..اذا كان تنسيق اللغة عندك بالعربي ..اما اذا بالانكليزي فقم بتغيير اسماء السبت والجمعة بالنسبة للعطل الرسمية اجعلها في جدول منفصل ثم استدعي مجموعها لتطرحه من عدد الايام التي تظهر لديك Function Work_Days(BegDate As Variant, EndDate As Variant) As Integer Dim WholeWeeks As Variant Dim DateCnt As Variant Dim EndDays As Integer On Error GoTo Err_Work_Days BegDate = DateValue(BegDate) EndDate = DateValue(EndDate) WholeWeeks = DateDiff("w", BegDate, EndDate) DateCnt = DateAdd("ww", WholeWeeks, BegDate) EndDays = 0 Do While DateCnt <= EndDate If Format(DateCnt, "ddd") <> "السبت" And _ Format(DateCnt, "ddd") <> "الجمعة" Then EndDays = EndDays + 1 End If DateCnt = DateAdd("d", 1, DateCnt) Loop Work_Days = WholeWeeks * 5 + EndDays Exit Function Err_Work_Days: ' If either BegDate or EndDate is Null, return a zero ' to indicate that no workdays passed between the two dates. If Err.Number = 94 Then Work_Days = 0 Exit Function Else ' If some other error occurs, provide a message. MsgBox "Error " & Err.Number & ": " & Err.Description End If End Function
    1 point
  23. وعليكم السلام ورحمة الله وبركاته .. 🙂
    1 point
  24. وعليكم السلام مشاركة مع اخي @مبرمج سابق وحسب فهمي ايضا .. استخدم الكود التالي لتنسب اسم التقرير للمتغير Reports(strReportName).Caption = "ct17R2"
    1 point
  25. وعليكم السلام بما انك لم ترسل ملف مدعوم بشرح كافي تفضل خلطة العملاء.xlsm94.67 kB · 19 downloads ايضاً https://www.officena.net/ib/applications/core/interface/file/attachment.php?id=207040&key=d1d90b44255334a0a45e54a449110d45
    1 point
  26. تمام عليك استاذ الفاضل @ناقل لو اردنا الاستغناء عن الحقل غير المنضم tx3 في بداية صفحة الاكواد نعلن عن متغير نصي هكذا والهدف ان نستخدم بدلا من الحقل النصي Dim tx As String وقيمته تكون tx = tx & "'" & Curr_Grp.Column(0) & "'," في امر طباعة نضع الامر If tx = "" Then MsgBox "لم تحدد السجلات المطلوبة من القائمة", , "رسالة": Exit Sub Dim k, w As String k = tx w = "st_mstr.Curr_Grp IN (" & Left(k, Len(k) - 1) & ")" DoCmd.OpenReport "r_1", acViewPreview, , w واضافة لتسهيل الغاء الاختيار نعمل زر امر نسمية الغاء مثلا ونضع فيه الامر Dim s As Variant tx = "" For Each s In Me.Curr_Grp.ItemsSelected Me.Curr_Grp.Selected(s) = False Next مع التحية والتقدير لاخي واستاذي ناقل والاعتذار ممن طلب وضع المثال حيث ان اتفاقي مع اخي جعفر ان يكون اهتمامي فقط للجانب النظري تحياتي
    1 point
  27. فورم لأسئلة دينية بعدد 4 إختيارات لتختار الإجابة الصحيحة الفيديو
    1 point
  28. وهذه طريقة أخرى بدون استخدام التايمر 🙂 Process Par.accdb
    1 point
  29. جزاك الله خيرا أستاذ شحادة صدقا هناك فرق شاسع جدا بين السرعتين مع العلم أن المستند فيه ألف حاشية تقريبا
    1 point
  30. وعليكم السلام ورحمة الله وبركاته ... اعمل مربع نص وسمه مثلا Text7 ثم في حدث عند عداد الوقت للنموذج ضع هذا الكود ... I = I + 1 Me.Text7 = I & "%" If I = 100 Then Me.TimerInterval = 0 ثم اصنع زر وضع في حدثه .... Me.TimerInterval = 100 جرب واعلمنا بالنتيجة ؟؟؟؟
    1 point
  31. جزاك الله خيرا على هذا الجمع الطيب
    1 point
  32. في هذه الحالة نرجع لنقطة الصفر التي كان ينبغي البدء منها يفضل إرفاق ملفك
    1 point
  33. مشاركة مع اساتذتي DELETE USER.id FROM USER WHERE (((USER.id) Not In (SELECT TOP 1 USER.id FROM USER)));
    1 point
  34. وعليكم السلام ورحمه الله وبركاته مشاركه مع اخى موسى جزاه الله خير باستخدام الشرط سواء لرقم اليوزر او لاسم اليوزر DELETE tblUsers.*, tblUsers.UsersName FROM tblUsers WHERE tblUsers.UsersName<>"admin"; غير ما يلزم بالتوفيق
    1 point
  35. وعليكم السلام ورحمة الله وبركاته أخي أبولو .. 🙂 كيف تميز السجل الأول عندك ؟ يحتاج تعمل شرط يستثنيه من بين السجلات .. وممكن تستخدم الجملة التالية كشرط أو معيار لجملة ال SQL أو الاستعلام إن كان لديك حقل ID في الجدول : DCount("*";"[TableName]";"[id]<=" & [id]) <> 1
    1 point
  36. سؤال : هل يمكن حصر رموز الأخطاء التي تظهر في رسائل نظام الأكسيس ، للتعرف على وصف كل منها ، ضمن جدول و تطبيق للبحث يمكن من خلاله البحث عبر شبكة الانترنت ( Google تحديدا ) عن أسباب الخطأ و حلوله ؟ الجواب : نعم و الحل في التطبيق المرفق تنويه : الجدول يحمل 2977 رمز خطأ و و صفه باللغة الانجليزية ، هذه دعوة لتوسيع التطبيق و اضافة تراجم لأوصاف رموز الأخطاء في الجدول ، مع وصف للحلول و الحالات التي تطلق رسائل الخطأ لكل رمز ، لعموم الفائدة ، كما يمكن استخدامه كمكتبة شخصية لتجميع الملاحظات حول الاخطاء التي تواجه كل منا . و الله من وراء القصد ... NA__ErrorCodeArchive.accdb
    1 point
  37. بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته يسعدني أن أقدم لكم اليوم هدية متواضعة من شأنها أن تعلم الإنسان قانون التطور وكيف كان يفكر الإنسان وكيف أصبح يفكر وعلى رأي المثل من فات قديمه تاه وهذه إحدى أفضل مقتنياتي برنامج إكسل 97 كامل وبورتابل اي محمول وبدون تثبيت وبحجم خرافي 10.5 مب فقط فك الضغط عنه واشتغل وهذا رابط التحميل ولا ينقصني سوى دعاؤكم
    1 point
  38. شكرا لمرورك الكريم استاذ ياسر الحافظ
    1 point
  39. هل ترغب بوضع ساعة في ورقة العمل الخاصة بك؟؟ يتم تحديثها كل ثانية مثل ساعة النظام تماما الحل تجده في المرفق لا تنسوا أخاكم محمد صالح من صالح دعائكم clock.rar الإصدار الأحدث ويوجد في المشاركة 14 من الموضوع clock3.rar والآن تم تطوير الملف بصورة أكثر احترافية ليعرض ساعة رقمية وساعة عقارب وإذا رغب أحبابي في الله يتم شرح فيديو للطريقة وخصوصا الساعة العقارب لا تحكم في رغبتك لعمل شرح إلا بعد مشاهدة هذا المرفق mas digital and analog clock.rar
    1 point
  40. السلام عليكم ورحمة الله تعالى وبركاته الحقيقة بدون ان اطيل عليكم كنت اريد تحزيم قاعدة بيانات لدى وتحويلها الى ملف تنفيذى ولكن لم يعجبنى الشكل المعتاد لتثبيت اى برنامج فاردت ان يكون برنامجى مميزا ففكرت مليها فى تصميم قاعدة بيانات تقوم بتثبيت نفسها داخل الويندوز فاعاننى الله على تصميمها دون الحاجة الى تحزيمها القاعدة الت صممتها بمجرد الفتح تبدا تلقائيا فى عمل تثبيت لها داخل الويندوز كا التالى اللوجو الخاص بى ويمكنك تغييره حسب ذوقك هذا اللوجو به شى مهم جدا وهى وحدة نمطية لتغيير لون البروجرس بار وهذا ايضا اردته ان يكون مختلفا عن الاخرين ناتى بعد ذلك الى نموذج التعريف الخاص بالبرنامج ويمكنك كتابة تعريف بسيط بالبرنامج وذلك لتعريف المستخدم ببرنامجك . لقد تركته فارغا ثم بعد ذلك نموذج الشروط والاتفاقيات الخاصة بك ويجب ان يوافق عليها المستخدم لمتابعت التثبيت . ولقد تركتها فارغه ثم بعد ذلك نموذج اكود التفعيل وذلك للتاكد من المالك او المشترى وبه كود بسيط فقط عند كتابة اربع حروف فى كل مربع نص يقوم بالانتقال الى المربع التالى تلقائيا كود التفعيل هو 1111222233334444 والان مع نموذج مكان التثبيت وبه اكواد مهمه جدا اتمنى ان تستفيدو منها اولا كود مكان تثبيت الويندوز وكود التغيير واختيار مكان اخر غير مكان الويندوز واجهتنى مشاكل كثيرا فى مسالة الصلاحيات الخاصة بالويندوز فاضررت الى انشاء مكان اخر غير Program file اسميته Program RK قد يسال سائل ولماذا RK اجيبه قائلا ملكش دعوه دا كلمة سر ههههههههه هذا هو الفولدر الخاص ببرنامجى وهذه الصورة بعد التنصيب والان مع نموذج التنصيب والشرح بداخله وبيمكنك الوصول اللى برنامجك بسهولة من سطح المكتب او قائمة ابدا وذلك لان البرنامج يقوم بعمل شورتكت لهم تلقائيا على سطح المكتب وقائمة استارت صورة من سطح المكتب وبعد التثبيت يقوم البرنامج بمسح كافة النماذج والجداول المؤقتة كنت قد انشائتها لتساعدنى فقط فى التنصيب ستجد برنامجك بعد التثبيت خالى من نماذج التثبيت هذه اما البرنامج الذى قمت بالتثبيت من خلاله فسيظل كما هو وذلك اذا احتجت الى التثبيت من جديد اتمنى ان ينال اعجابكم نظرا لنفاذ حجم رفع المرفقات سارفعه فى المشاركة التالية ان شاء الله والان مع البرنامج اتمنى ان ينال على اعجابكم . Elsayed Pro.rar
    1 point
  41. هذا المثال فى الملف المرفق اعددته بناء على طلب أحد الزملاء ،ليقوم بعد الخلايا التي لها لون معين و أطرح هنا مثالين فيما يلي : الأول يقوم بعد الخلايا فى مجال معين و التي لها نفس لون الخلية التي بها الدالة و هو يحتاج لمتغير واحد وهو المجال المطلوب عد الخلايا فيه CountByCellColor2.rar و طبعا عند التجربة و تعديل لون الخلية يحب تحرير الخلية لاعادة تفعيل الدالة و ذلك عن طريق F2 ثم Enter يتم تطبيق الدالة فى المثال الاول كما يلي =countmycolor2(coloredarea) اذا كان المجال له اسم مثل coloredarea او مباشرة كما يلي =countmycolor2(E7:J17) و الدالة فى المثال الاول هي Function countmycolor2(Myrange As range) Dim Mycolor As Integer Mycolor = activecell.Interior.ColorIndex Dim Myrow As Long, MyCol As Long Myrow = Myrange.Rows.Count MyCol = Myrange.Columns.Count Mycells = Myrange.Cells.Count Dim colorcounter As Integer, counterx As Integer For i = 0 To Myrow - 1 For j = 0 To MyCol - 1 counterx = counterx + 1 If Myrange.Cells(counterx).Interior.ColorIndex = Mycolor Then colorcounter = colorcounter + 1 End If Next j Next i countmycolor2 = colorcounter End Function المثال الثاني و الثاني هو يقوم بعد الخلايا الملونة بلون معين فى نطاق محدد باستخدام الكود، و يحتاج الي متغيرين الأول هو المجال المطلوب عد الخلايا بداخله و الثاني هو كود اللون المطلوب عد الخلايا التي تم تلوينها به CountByCellColor.rar و يتم تطبيق الدالة فى المثال الثاني كالتالي: مثال =countmycolor(coloredarea,3) اذا كان المجال له اسم مثل coloredarea او مباشرة كما يلي =countmycolor(E7:J17,8) Function countmycolor(Myrange As range, Mycolor As Integer) If IsNull(Mycolor) Or Mycolor > 56 Or Not IsNumeric(Mycolor) Then MsgBox " choose a number between 0 and 56" End If Dim Myrow As Long, MyCol As Long Myrow = Myrange.Rows.Count MyCol = Myrange.Columns.Count Mycells = Myrange.Cells.Count Dim colorcounter As Integer, counterx As Integer For i = 0 To Myrow - 1 For j = 0 To MyCol - 1 counterx = counterx + 1 If Myrange.Cells(counterx).Interior.ColorIndex = Mycolor Then colorcounter = colorcounter + 1 End If Next j Next i countmycolor = colorcounter End Function و هنا سنحتاج لمعرفة اكواد الالون لذا اضفت دالة لسردها و جدير بالذكر أن طلب صاحب الملف لا يشتمل ألوان متغيرة ، و لكن الألوان لديه ثابتة لذا يحتاج لمعرفة اللون مرة واحدة فقط ، مثلا الاحمر كوده 3 و لمعرفة اكواد الالون شغل الدالة التالية مع وقوف المؤشر فى عمود خالي و سيسرد لك البيانات و الوانها Sub Listcolors() ActiveCell.Offset(0, 0).Value = "ColorIndex" ActiveCell.Offset(0, 1).Value = "Color" For i = 1 To 56 ActiveCell.Offset(i, 0).Value = i ActiveCell.Offset(i, 1).Interior.ColorIndex = i Next i End Sub
    1 point
  42. أسعد الله ايامك أخي سعد فعلا هذا هدفي من ذلك للعلم لدي على جهازي جميع نسخ الأوفيس الأساسي فيها 2010 والباقي بورتابل أستعمله وقت الحاجة حتى أتمكن من مقارنة النسخ ***** سهّل الله حاجاتك أخي مجدي وآنسك بمن تحب وزاد مجدك ***** وفيك بارك أخي الشهابي أرجو أن ينفعنا الله بها ****** أخي جمال زادك الله حسنا وبهاءً فعلاً نحن أسرة واحدة اللهم بارك لنا في جمعنا هذا واجعلنا من المتحابين فيك آمين
    1 point
  43. ربنا يجيبه بالسلامة وأقترح أنه من يغيب عن المنتدى مدة أكثر من شهر يتوجب عليه ألا يدخل علينا وإيده فاضية بل يحمل معه هدية تعوضنا غيابه
    1 point
  44. أسعدني مروركما الكريم أخي عبد الله وأخي يوسف وفقنا الله وإياكم لكل ما يحب ويرضى
    1 point
  45. مرحبا بك في بيتك اخي عادل وأدعو الله ألا يبعدك عنا في المستقبل فلقد تعلمنا منك الكثير وفقك الله وسدد خطاك
    1 point
  46. أخي الكريم أحمد يرجع السبب في هذه المسافات إلى تغيير قيمة المحاذاة العمودية vertical alignment إلى مضبوطة justified وهذه القائمة توجد في نافذة إعداد الصفحة page setup في التبويب الثالث التخطيط layout والصواب أن تكون أعلى top جرب وأخبرني بالنتيجة
    1 point
  47. لحل هذا اللغز أخي الكريم ضع في عمود معين تختاره سلسلة الأرقام التي تريد تكرارها ولو إلى مليون (نفترض أنه العمود b وسلسلة الأرقم حتى الرقم 20) ثم ضع في العمود الذي تريد التسلسل بالتكرار فيه هذه المعادلة (نفترض أنه مثلاً العمود A وأول خلية بها أرقام هي a1) =INDEX($B$1:$B$20,ROUNDUP(ROWS(A$1:A1)/5,0)) جرب وأخبرني بالنتيجة
    1 point
  48. السلام عليكم اخي الحسامي و انت ايضا فكرتك رائعة كعادتك التي نتمني ان لا نحرم منها ابدا و اسمح لي باضافة بسيطة تحياتي COLOR.rar
    1 point
×
×
  • اضف...

Important Information