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

الأخوة الأفاضل: السلام عليكم وجدت هذا الموقع بالصدفة وبه مجموعة من الأكواد والشروحات لعل البعض يستفيد منها . https://www.isladogs.co.uk/code-samples/index.html

وعليكم السلام ورحمة الله تعالى وبركاته تفضل جرب اخي Sub FindCouleur() Dim j(1 To 2) As String, F As Variant Dim a As Range, R As Range, T&, Cpt&, lCol&, lrow& Dim WS As Worksheet: Set WS = Worksheets("0") Application.ScreenUpdating = False lrow = WS.Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row lCol = WS.Cells(1, Columns.Count).End(xlToLeft).Column j(1) = [Al14]: j(2) = [Al15] Set a = WS. _ Range("A1", WS.Cells(lrow, lCol)) F = Array(j(1), j(2)) With a .Interior.ColorIndex = xlNone For Cpt = LBound(F) To UBound(F) Set R = .Cells(.Cells.Count) For T = 1 To WorksheetFunction.CountIf(a, F(Cpt)) Set R = .Cells.Find(What:=F(Cpt), LookIn:=xlValues, LookAt:=xlWhole, _ After:=R, MatchCase:=False) R.Interior.Color = vbYellow Next T Next End With Application.ScreenUpdating = True End Sub أرقام.xlsm

يكفي إنها عجبتك أختي الكريمة ، وبعدين أنا ولا الأخ @jo_2010 أو أي حد من الأساتذة ، هنا كلنا وااااحد 😊

المهم أختي الكريمة @safaa salem5 نكون عند حسن الظن وأثني على كلام الأستاذ @عمر ضاحى 100%

بسم الله الرحمن الرحيم السلام عليكم ورحمه الله وبركاته اساتذتي واخوتى هذا الملف به فهرس لجميع المنتدي ليسهل البحث للاعضاء يوجد فورم يمكنك البحث بها كما يمكنكم استخدام الفلتر العادي وبمجرد الضغط على اي نتيجه من نتائج البحث يتم فتح صفحتها في المنتدي ولا انسي فضل استاذي الكبير ياسر خليل على المساعده في عمل الملف تم تحديث الملف يوم الخميس الموافق 10 - 04 - 2025 فهرس منتدي الاكسيل.xlsb

جزاك الله خيرا كفيت ووفيت عمل يذكر فيشكر

معلمى الفاضل دة شرف كبير لى انت استاذى وستظل معلمى الفاضل

هو ليه ياجماعه مش بتدونا فرصه نختار افضل اجابه انا دلوقتى عايزه اديها ل FOKSH انا قعدت اعدل فى اسماء الزراير ساعه وكتبت الكود زى ساعه الاستاذ جو بس فى الاخر ما اشتغلتش وتعبت جدا وانا مقدره تعب حضرتك جدا لان فيها تعديلات كتيره وانا مش عارفه اشكرك ازاى

تسلم والله لقد اغوغرقت عيناى بالدموع لما شوفتها شغاله

مساهمة بسيطة calc.accdb

وعليكم السلام أستاذ @عبد الله قدور الأستاذ @ابو البشر ذهب بعيداً..! بسبب التوصيف غير الواضح في الاقتباس ("لقد قمت بتخزين صورة في كائن ole")، وما ينبغي أن تكون علي العبارة ("لقد قمت بتخزين صورة في حقل ole") لعرض الصورة المخزنة في حقل OLE يتطلب الأمر عنصر تحكم Image، وباستخدام الخصيصة PictureData يمكن عرض الصورة Me.ImgViewer.PictureData([Your OLE Fied]) المثال المرفق يقوم بتخزين الصورة في حقل OLE ومن ثم عرضها باستخدام عنصر التحكم Image PictureViewer.accdb

واحدة من هدايا المنتدى هدية لك بعد عمل بعض التعديلات عليها JO_calc.accdb

وعليكم السلام ورحمه الله وبركاته تفضل اخي هانى Unique.xlsb

باستخدام خاصية البحث في المنتدي ............ هناك العشرات من تصاميم الات الحاسبة بأنواعها واشكالها المختلفة

جزاك الله خيرا يا مبدع يا استاذ : عبداللطيف شكرا

وعليكم السلام ورحمة الله وبركاته 'طباعة حسب البيانات.xlsm

وعليكم السلام ورحمة الله تعالى وبركاته ربما تقصد جمع قيم العمود بشرط الخلفية الزرقاء تفضل جرب وضع هدا لكود في موديول Function TotalRng(SumRange As Range, SumColor As Range) Dim SumColorValue As Integer Dim SumRng As Long SumColorValue = SumColor.Interior.ColorIndex Set b = SumRange For Each b In SumRange If b.Interior.ColorIndex = SumColorValue Then SumRng = SumRng + b.Value End If Next b TotalRng = SumRng End Function وفي الخلية H17 =TotalRng(البيانات!$H$2:$H$80;K1) مع تلوين الخلية K1 باللون الهدف فرز بيانات ذات اللون 2الازرق.xlsm

السلام عليكم ورحمة الله نعالى وبركاته بعد ادن الاستاد أ / محمد صالح بالنسبة لاظهار بيانات اليوم فقط تفضل جرب اخي Private Sub UserForm_Initialize() Dim f As Worksheet: Set f = Sheets("ورقة1") Set d = CreateObject("scripting.dictionary") Col = f.Range("B4:E" & f.[B65000].End(xlUp).Row).Value Rng = UBound(Col, 2) With Me.ListView1 .Gridlines = True .FullRowSelect = True .View = lvwReport .ColumnHeaders.Add , , "code", 0 .ColumnHeaders.Add , , "م", 30, lvwColumnCenter .ColumnHeaders.Add , , "التاريخ", 80, lvwColumnCenter .ColumnHeaders.Add , , "اسم العميل", 120, lvwColumnCenter .ColumnHeaders.Add , , "الرقم ", 60, lvwColumnCenter Cpt = 1 ' من بداية الجدول ' For i = 1 To UBound(Col) For i = UBound(Col) - 19 To UBound(Col) ' تحديد اخر 20 صف If Col(i, 2) = Date Then ' شرط تاريخ اليوم .ListItems.Add , , Col(i, 1) For k = 1 To Rng .ListItems(Cpt).ListSubItems.Add , , Col(i, k) Next k Cpt = Cpt + 1 End If Next i End With End Sub listview 2.xlsm

وبدون عمود مساعد يمكنك استعمال هذه المعادلة في الخلية L25 =IF(L24-L25<0,100,0)+L24-L25 وهذه في M25 =IF(L24-L25<0,-1,0)+M24-M25 بالتوفيق

وعليكم السلام ورحمة الله تعالى وبركاته بعد ادن الاستاد محمد صالح اليك حلول اخرى =INDEX($B$2:$D$6, MATCH(A10,$A$2:$A$6,0), MATCH(B10, $B$1:$D$1, 0)) او =HLOOKUP(I12,$H$1:$K$6,MATCH(H12,$H$1:$H$6,0),0) اوفيسنا.xlsx

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