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

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

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

    أ / محمد صالح

    أوفيسنا


    • نقاط

      18

    • Posts

      4,018


  2. مبرمج سابق

    مبرمج سابق

    03 عضو مميز


    • نقاط

      10

    • Posts

      221


  3. Moosak

    Moosak

    الخبراء


    • نقاط

      7

    • Posts

      837


  4. Eng.Qassim

    Eng.Qassim

    04 عضو فضي


    • نقاط

      6

    • Posts

      1,457


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. والصعايدة غالية علية 😂 يا سلاااام ...دة انا اموت في الصعايدة
    1 point
  12. خدعتني هذه الجملة .. ولم اكلف نفسي بتتبع الكود 🤣
    1 point
  13. شكرا للكلماتك الطيبة في properties الخاص بها غير value إلى true
    1 point
  14. نعم احسنت اخي قاسم الحقيقة ان الموضوع فعلا يحتاج ايضاح كما اشار مستر @Moosak على كل حال كمداخلة اخيرة الى ان تتضح الامور للاخوة نحتاج احيان الى اعادة تسمية كائن في قاعدة البيانات سواء كان جدول او استعلام او فورم او تقرير او وحدة نمطية ونرغب ان يتم التغيير عن طريق الكود DoCmd.Rename "r_2", acReport, "companies" في هذا الامر لدينا ثلاث معلمات NewName هنا يساوي r_2 ObjectType وهو نوع الكائن و هنا تقرير " بعض قدامي المبرمجين بدلا من تحديد نوع الكائن يضع القيمة للكائن وهنا رقم 3 " OldName وهو اسم التقرير القديم companies تحياتي ولنا لقاء في موضوع اخر
    1 point
  15. تفضل __سجل المدرسة2022.xls
    1 point
  16. 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
  17. الموضوع كما قلت حضرتك بسيط جدا ولا يحتاج استيراد ولا تصدير ولا معادلات فقط تقوم بتصفية filter الاسم المطلوب ثم طباعة على طابعة الويندوز pdf أو استعمال كود تصدير الشيت النشط إلى pdf ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "/" & Filename & ".pdf", , , False بالتوفيق
    1 point
  18. منطقيا حضرتك لا تحتاج لمعادلة في هذه الحالة فصاحبا هذين الصفين لهما اسمان وكل لجانهما احتياطي لذا يلزمك كتابة اسمهما أسفل الاسمين الاحتياطي يدويا أو بمعادلة بسيطة مثل =sheet1!$c17 =sheet1!$c32 مع سحب المعادلة أفقيا بالتوفيق
    1 point
  19. اولا انشئ جدول باسم 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
  20. ههههه والله انا فهمت هيك...على كل حال زيادة في المعلومات واثراء الموضوع
    1 point
  21. وعليكم السلام هذه الدالة من موقع مايكروسوفت ..اذا كان تنسيق اللغة عندك بالعربي ..اما اذا بالانكليزي فقم بتغيير اسماء السبت والجمعة بالنسبة للعطل الرسمية اجعلها في جدول منفصل ثم استدعي مجموعها لتطرحه من عدد الايام التي تظهر لديك 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
  22. وعليكم السلام مشاركة مع اخي @مبرمج سابق وحسب فهمي ايضا .. استخدم الكود التالي لتنسب اسم التقرير للمتغير Reports(strReportName).Caption = "ct17R2"
    1 point
  23. وعليكم السلام بما انك لم ترسل ملف مدعوم بشرح كافي تفضل خلطة العملاء.xlsm94.67 kB · 19 downloads ايضاً https://www.officena.net/ib/applications/core/interface/file/attachment.php?id=207040&key=d1d90b44255334a0a45e54a449110d45
    1 point
  24. تمام عليك استاذ الفاضل @ناقل لو اردنا الاستغناء عن الحقل غير المنضم 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
  25. كيف لا ... وقد اختصرت لنا كتابة الاكواد وسرعة الانجاز .... اشكرك مرة اخرى اخي الكريم وكل جهد تبذلة في المنتدى .... هنيئا لنا بك ..
    1 point
  26. فورم لأسئلة دينية بعدد 4 إختيارات لتختار الإجابة الصحيحة الفيديو
    1 point
  27. وهذه طريقة أخرى بدون استخدام التايمر 🙂 Process Par.accdb
    1 point
  28. هل هذ الصورة المطلوبة .....
    1 point
  29. وعليكم السلام ورحمة الله وبركاته ... اعمل مربع نص وسمه مثلا Text7 ثم في حدث عند عداد الوقت للنموذج ضع هذا الكود ... I = I + 1 Me.Text7 = I & "%" If I = 100 Then Me.TimerInterval = 0 ثم اصنع زر وضع في حدثه .... Me.TimerInterval = 100 جرب واعلمنا بالنتيجة ؟؟؟؟
    1 point
  30. جزاك الله خيرا على هذا الجمع الطيب
    1 point
  31. مع التحية والتقدير للاستاذ محمد البرناوي على الحل الرائع ومن باب تعدد الحلول ولكوني من المدرسة القديمة ومن انصار استخدام مربعات النص لاختصار الاكواد فاني سوف اضع طريقة ليست منافسة للكود الرائع لاستاذنا الفاضل ولكن حل على طريقة الطيبين في البداية استخدمنا مربع نص غير منضم اسميته tx3 وقيمته تساوي Me.tx3 = tx3 & "'" & Curr_Grp.Column(0) & "'," ثم في زر الامر لفتح التقرير وضعنا الامر Dim k, w As String k = tx3 w = "st_mstr.Curr_Grp IN (" & Left(k, Len(k) - 1) & ")" DoCmd.OpenReport "r_1", acViewPreview, , w والنتيجة في الصورة تحياتي
    1 point
  32. في هذه الحالة نرجع لنقطة الصفر التي كان ينبغي البدء منها يفضل إرفاق ملفك
    1 point
  33. طيب انظر الصور والمرفق هل هذا هو المطلوب ........ Info list.accdb
    1 point
  34. مشاركة مع اساتذتي DELETE USER.id FROM USER WHERE (((USER.id) Not In (SELECT TOP 1 USER.id FROM USER)));
    1 point
  35. وعليكم السلام ورحمه الله وبركاته مشاركه مع اخى موسى جزاه الله خير باستخدام الشرط سواء لرقم اليوزر او لاسم اليوزر DELETE tblUsers.*, tblUsers.UsersName FROM tblUsers WHERE tblUsers.UsersName<>"admin"; غير ما يلزم بالتوفيق
    1 point
  36. وعليكم السلام ورحمة الله وبركاته أخي أبولو .. 🙂 كيف تميز السجل الأول عندك ؟ يحتاج تعمل شرط يستثنيه من بين السجلات .. وممكن تستخدم الجملة التالية كشرط أو معيار لجملة ال SQL أو الاستعلام إن كان لديك حقل ID في الجدول : DCount("*";"[TableName]";"[id]<=" & [id]) <> 1
    1 point
  37. سؤال : هل يمكن حصر رموز الأخطاء التي تظهر في رسائل نظام الأكسيس ، للتعرف على وصف كل منها ، ضمن جدول و تطبيق للبحث يمكن من خلاله البحث عبر شبكة الانترنت ( Google تحديدا ) عن أسباب الخطأ و حلوله ؟ الجواب : نعم و الحل في التطبيق المرفق تنويه : الجدول يحمل 2977 رمز خطأ و و صفه باللغة الانجليزية ، هذه دعوة لتوسيع التطبيق و اضافة تراجم لأوصاف رموز الأخطاء في الجدول ، مع وصف للحلول و الحالات التي تطلق رسائل الخطأ لكل رمز ، لعموم الفائدة ، كما يمكن استخدامه كمكتبة شخصية لتجميع الملاحظات حول الاخطاء التي تواجه كل منا . و الله من وراء القصد ... NA__ErrorCodeArchive.accdb
    1 point
  38. بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته يسعدني أن أقدم لكم اليوم هدية متواضعة من شأنها أن تعلم الإنسان قانون التطور وكيف كان يفكر الإنسان وكيف أصبح يفكر وعلى رأي المثل من فات قديمه تاه وهذه إحدى أفضل مقتنياتي برنامج إكسل 97 كامل وبورتابل اي محمول وبدون تثبيت وبحجم خرافي 10.5 مب فقط فك الضغط عنه واشتغل وهذا رابط التحميل ولا ينقصني سوى دعاؤكم
    1 point
  39. شكرا لمرورك الكريم استاذ ياسر الحافظ
    1 point
  40. هل ترغب بوضع ساعة في ورقة العمل الخاصة بك؟؟ يتم تحديثها كل ثانية مثل ساعة النظام تماما الحل تجده في المرفق لا تنسوا أخاكم محمد صالح من صالح دعائكم clock.rar الإصدار الأحدث ويوجد في المشاركة 14 من الموضوع clock3.rar والآن تم تطوير الملف بصورة أكثر احترافية ليعرض ساعة رقمية وساعة عقارب وإذا رغب أحبابي في الله يتم شرح فيديو للطريقة وخصوصا الساعة العقارب لا تحكم في رغبتك لعمل شرح إلا بعد مشاهدة هذا المرفق mas digital and analog clock.rar
    1 point
  41. السلام عليكم ورحمة الله تعالى وبركاته الحقيقة بدون ان اطيل عليكم كنت اريد تحزيم قاعدة بيانات لدى وتحويلها الى ملف تنفيذى ولكن لم يعجبنى الشكل المعتاد لتثبيت اى برنامج فاردت ان يكون برنامجى مميزا ففكرت مليها فى تصميم قاعدة بيانات تقوم بتثبيت نفسها داخل الويندوز فاعاننى الله على تصميمها دون الحاجة الى تحزيمها القاعدة الت صممتها بمجرد الفتح تبدا تلقائيا فى عمل تثبيت لها داخل الويندوز كا التالى اللوجو الخاص بى ويمكنك تغييره حسب ذوقك هذا اللوجو به شى مهم جدا وهى وحدة نمطية لتغيير لون البروجرس بار وهذا ايضا اردته ان يكون مختلفا عن الاخرين ناتى بعد ذلك الى نموذج التعريف الخاص بالبرنامج ويمكنك كتابة تعريف بسيط بالبرنامج وذلك لتعريف المستخدم ببرنامجك . لقد تركته فارغا ثم بعد ذلك نموذج الشروط والاتفاقيات الخاصة بك ويجب ان يوافق عليها المستخدم لمتابعت التثبيت . ولقد تركتها فارغه ثم بعد ذلك نموذج اكود التفعيل وذلك للتاكد من المالك او المشترى وبه كود بسيط فقط عند كتابة اربع حروف فى كل مربع نص يقوم بالانتقال الى المربع التالى تلقائيا كود التفعيل هو 1111222233334444 والان مع نموذج مكان التثبيت وبه اكواد مهمه جدا اتمنى ان تستفيدو منها اولا كود مكان تثبيت الويندوز وكود التغيير واختيار مكان اخر غير مكان الويندوز واجهتنى مشاكل كثيرا فى مسالة الصلاحيات الخاصة بالويندوز فاضررت الى انشاء مكان اخر غير Program file اسميته Program RK قد يسال سائل ولماذا RK اجيبه قائلا ملكش دعوه دا كلمة سر ههههههههه هذا هو الفولدر الخاص ببرنامجى وهذه الصورة بعد التنصيب والان مع نموذج التنصيب والشرح بداخله وبيمكنك الوصول اللى برنامجك بسهولة من سطح المكتب او قائمة ابدا وذلك لان البرنامج يقوم بعمل شورتكت لهم تلقائيا على سطح المكتب وقائمة استارت صورة من سطح المكتب وبعد التثبيت يقوم البرنامج بمسح كافة النماذج والجداول المؤقتة كنت قد انشائتها لتساعدنى فقط فى التنصيب ستجد برنامجك بعد التثبيت خالى من نماذج التثبيت هذه اما البرنامج الذى قمت بالتثبيت من خلاله فسيظل كما هو وذلك اذا احتجت الى التثبيت من جديد اتمنى ان ينال اعجابكم نظرا لنفاذ حجم رفع المرفقات سارفعه فى المشاركة التالية ان شاء الله والان مع البرنامج اتمنى ان ينال على اعجابكم . Elsayed Pro.rar
    1 point
  42. هذا المثال فى الملف المرفق اعددته بناء على طلب أحد الزملاء ،ليقوم بعد الخلايا التي لها لون معين و أطرح هنا مثالين فيما يلي : الأول يقوم بعد الخلايا فى مجال معين و التي لها نفس لون الخلية التي بها الدالة و هو يحتاج لمتغير واحد وهو المجال المطلوب عد الخلايا فيه 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
  43. أسعد الله ايامك أخي سعد فعلا هذا هدفي من ذلك للعلم لدي على جهازي جميع نسخ الأوفيس الأساسي فيها 2010 والباقي بورتابل أستعمله وقت الحاجة حتى أتمكن من مقارنة النسخ ***** سهّل الله حاجاتك أخي مجدي وآنسك بمن تحب وزاد مجدك ***** وفيك بارك أخي الشهابي أرجو أن ينفعنا الله بها ****** أخي جمال زادك الله حسنا وبهاءً فعلاً نحن أسرة واحدة اللهم بارك لنا في جمعنا هذا واجعلنا من المتحابين فيك آمين
    1 point
  44. مرحبا بك في بيتك اخي عادل وأدعو الله ألا يبعدك عنا في المستقبل فلقد تعلمنا منك الكثير وفقك الله وسدد خطاك
    1 point
  45. أخي الكريم أحمد يرجع السبب في هذه المسافات إلى تغيير قيمة المحاذاة العمودية vertical alignment إلى مضبوطة justified وهذه القائمة توجد في نافذة إعداد الصفحة page setup في التبويب الثالث التخطيط layout والصواب أن تكون أعلى top جرب وأخبرني بالنتيجة
    1 point
  46. السلام عليكم اخي الحسامي و انت ايضا فكرتك رائعة كعادتك التي نتمني ان لا نحرم منها ابدا و اسمح لي باضافة بسيطة تحياتي COLOR.rar
    1 point
  47. السلام عليكم ورحمة الله وبركاته استاذنا العزيز محمد طاهر عمل مبدع وصنع دالة لهذا الغرض لهو عمل كبير ومبدع وجزاك الله خيرا اخي عادل حنفي عمل متميز كعادتك وهنا مشاركة مني فقط عند اختيار لون بواسطة المؤشر يقوم بالعد ووضع الناتج واللون CountByCellColor-hosami.rar
    1 point
  48. السلام عليكم و اسمح لي ايضا استاذنا لسهولة الوصول للون خلية معينة مباشرة عند تحديد خلية معينه و الضغط علي زر تظهر رسالة تعطي درجة لون الخلية و ان كان ليس بها ايلون تظهر رسالة اخري تفيد بانها XLNONE اي بدون لون خالص تحياتي و تقديري Book1.rar
    1 point
×
×
  • اضف...

Important Information