عبدالله باقشير

جزاك الله خيرا لا يحتاج لها كود العملية نسخ لصق تفي بالغرض

الصور المتاحة في الكود التي يقبلها الشكل التلقائي كتعبئة فقط شكرا جزيلا

السلام عليكم بارك الله فيك وجزاك خيرا تقبل تحياتي وشكري

السلام عليكم محبي العلم والتعليم بارك الله فيكم جميعا وجزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم عملت دالة للجمع بين تاريخين وبشرط للاستخدام بالكود Option Explicit Function kh_SumIf(Rng As Range, Gri As String, GriColumn As Integer, dt1 As Range, dt2 As Range, DateColumn As Integer, SumColumn As Integer) Dim MyValSum#, R% With Rng For R = 1 To .Rows.Count If CStr(.Cells(R, GriColumn)) = Gri Then Select Case .Cells(R, DateColumn).Value2 Case dt1.Value2 To dt2.Value2 MyValSum = MyValSum + Val(.Cells(R, SumColumn)) End Select End If Next End With kh_SumIf = MyValSum End Function تفضل المرفق 2003 مثال حساب بين تارخيين.rar

السلام عليكم الاخ الفاضل Ahmed Elbhiry --------حفظه الله جزاك الله خيرا وبارك الله فيكم تقبل تحياتي وشكري

السلام عليكم ورحمة الله وبركاته الشكر واصل لجميع المشاركين كلا باسمه جزاكم الله خيرا وبارك الله فيكم هنا نتاكد من ان اسم مجلد الملف مسار كامل اذا كان اسم الملف مسار كامل اكيد حيكون في النص النقطتين فوق بعض ":" InStr تبحث في النص kh_pic عن النقطتين وتعيد رقما عن مكانه في النص اذا كانت صفرا معناه ان الموجود اسم فقط وليس مسار في هذه الحالة حنستخدم مسار ملف الاكسل ============================================== Dir من استخدامات FileSystem دالة تستخدم لمعرفة دليل الملف وخواصه If Not Dir(MyFile & Trim(Tp), vbDirectory) = vbNullString Then هنا نتاكد من وجود الصورة المسماة اذا كانت موجودة MyShap.Fill.UserPicture MyFile & Trim(Tp) نعبي الشكل التلقائي بهذه الصورة لو عملتها يدويا بهذه الخطوات من تنسيق الشكل التلقائي الوان وخطوط تعبئة اللون تاثيرات التعبئة صورة تحديد صورة ارجوا ان يكون شرحنا مفهوما لديكم ودمتم في حفظ الله

جزاك الله خيرا اخي الحبيب احمد يعقوب تقبل تحياتي وشكري

السلام عليكم بعد اذن اخي ابو انصار ممكن للتنسيق الشرطي اي يتعامل مع اسم معرف من اوراق اخرى اذا كنت تتعامل مع اسم معرف حيكون احسن والا ممكن تسمي جميع خلايا الورقة الاخرى باسم مثلا انا سميت الاسم myrng لجميع خلايا شيت 2 Sheet2!$1:$65536 واستخدمت المعادلة هذه في التنسيق الشرطي =INDEX(myrng;ROW(M8);COLUMN(M8))=0 شاهد المرفق تنسيق شرطى.rar

الكود السابق لي للاوائل يقوم بما ذكر اعلاه الرابط التالي http://www.officena.net/ib/index.php?showtopic=35409

السلام عليكم ورحمة الله وبركاته الشكر واصل لجميع المشاركين -------حفظهم الله شاهد المرفق اكسل 2003/2007 ترتيب العشرة الاوائل حسب المجموع والعمر1.rar

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

الصورة تظهر في الشكل التلقائي اللي سميته في الدالة انقل الشكل التلقائي الى اي مكان تريده يعني لا يهم موقع خلية الدالة ممكن تكون في اي مكان في الورقة شاهد المرفق الجديد في المشاركة الاولى

صدقت فيما ذكرت فهو نحلة المنتدى

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

السلام عليكم ورحمة الله وبركاته اخواني الاحباء الجزيرة احمد فضيلة حفظكم الله ورعاكم ====================== جزاكم الله خيرا وبارك الله فيكم تقبلوا تحياتي وشكري =======================

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

السلام عليكم ورحمة الله وبركاته ترتيب العشرة الاوائل حسب المجموع والعمر ادخل معطياتك بداية الكود '================================================== ' من نطاق البيانات '================================================== '''''''' اسم النطاق او عنوانه مع اسم الورقة Private Const MyRng As String = "RangDate" '''''''' ارقام الاعمدة من نطاق البيانات '''''''' :حسب الترتيب التالي '''''''' رقم الجلوس,الاسم,تاريخ الميلاد,الفصل '''''''' SeatNum,Name,Bridate,MyClass Private Const MyColumn As String = "1,2,4,3" '================================================== ' من ورقة الاوائل '================================================== '''''''' اول خلية لوضع لست الاوائل Private Const MyRngPast As String = "D7" '''''''' نطاق اسماء الفصول Private Const MyClass As String = "P7:P13" '''''''' نطاق اسماء المواد ومواقعها Private Const MyTotal As String = "R7:T19" '''''''' تنسيق التاريخ Private Const DateFormat As String = "yyyy/mm/dd" '================================================== '================================================== المرفق اكسل2003 اكسل2007 ترتيب العشرة الاوائل حسب المجموع والعمر.rar ======================================================= تم التعديل حسب ملاحظة ايسم ابراهيم ادناه المرفق اكسل 2003/2007 ترتيب العشرة الاوائل حسب المجموع والعمر1.rar 61.97K 0 عدد مرات التحميل

جزاك الله خيرا اخي عبدالله و بارك الله فيك وشكرا جزيلا على التشجيع والتثبيت وجمعة مباركة ودمتم في حفظ الله

الاخ الفاضل/ الشهابي

شاهد الرابط التالي http://www.officena.net/ib/index.php?showtopic=40613

السلام عليكم ورحمة الله وبركاته جمعة مباركة دالة لاضافة صور الى نموذج معين من فولدر المطلوب فيها اسم الصورة واسم الشكل التلقائي الذي تريد اظهار الصورة فيه ملاحظة مهمة : عند تعيين الخلية اللي فيها اسم الصورة يجب ان يكون ملحوق باسم الورقة مثلا =kh_AddPicture(Sheet1!H2;"myimg1") كود الدالة : Option Explicit Option Compare Text '''اسم مجلد الصور Private Const kh_pic As String = "MyImeg" Function kh_AddPicture(MyRng As Range, iName As String) Dim MyFile As String On Error GoTo 1 MyRng.Worksheet.Shapes(iName).Fill.Solid MyFile = ThisWorkbook.Path & "\" & kh_pic & "\" MyFile = MyFile & "\" & CStr(MyRng) & ".jpg" If Not Dir(MyFile, vbDirectory) = vbNullString Then MyRng.Worksheet.Shapes(iName).Fill.UserPicture MyFile End If 1 kh_AddPicture = "" End Function هو طلب لاحدهم وجعلته هنا لتعم الفائدة المرفق اكسل 2003 اكسل 2007 دالة لاضافة صور الى نموذج معين من فولدر.rar =================================================== ملحوظة ارجوا من الذين حملوا المرفق هذا يغيروا كود الدالة الى الكود المعدل ادناه =================================================== تم تعديل الدالة لتشمل صيغ الصور التي تريدها كود الدالة الجديد Option Explicit Option Compare Text '============================================= '============================================= ' اسم مجلد الصور ' اذا كان مجلد الصور في نفس مجلد ملف الاكسل ' اكتب اسمه فقط ' والا اكتب المسار كاملا ' "D:\MyDocument\MyFunction\photo" Private Const kh_pic As String = "MyImeg" '============================================= ' امكانية تحرير اي نوع من الصور لديك ادناه Private Const MyTyp As String = ".jpg,.bmp,.gif,.png,.tif" '============================================= '============================================= Function kh_AddPicture(MyRng As Range, iName As String) Dim Tp Dim MyShap As Shape Dim MyFile As String, MyPath As String Dim ibo As Boolean '----------------------------------------- On Error Resume Next Set MyShap = MyRng.Worksheet.Shapes(iName) If iName = "" Or Err Then Err.Clear: GoTo 1 '----------------------------------------- MyShap.Fill.Solid If Not InStr(kh_pic, ":") Then MyPath = ThisWorkbook.Path MyFile = MyPath & "\" & kh_pic & "\" & CStr(MyRng) '----------------------------------------- For Each Tp In Split(MyTyp, ",") If Not Dir(MyFile & Trim(Tp), vbDirectory) = vbNullString Then MyShap.Fill.UserPicture MyFile & Trim(Tp) ibo = True Exit For End If Next '----------------------------------------- 1: Set MyShap = Nothing kh_AddPicture = ibo End Function المرفق اكسل 2003/2007 دالة لاضافة صور من مجلد الى شكل تلقائي.rar

السلام عليكم على السريع استخدم الكود التالي Option Explicit Option Compare Text '======================================== ''''''''نطاق الرقم الوظيفي Private Const MyRng As String = "H2,T2,H20,T20,H38,T38" '======================================== Private Sub Worksheet_Change(ByVal Target As Range) Dim MyPicture As Object Dim a As String, q As String, em As String, mm As String On Error Resume Next If Intersect(Target, Range(MyRng)) Is Nothing Then Exit Sub q = ActiveWorkbook.Path em = q & "\" & "empty.JPG" a = Target.Value mm = q & "\" & a & ".JPG" Set MyPicture = kh_img(Target.Address) If Not MyPicture Is Nothing Then MyPicture.Picture = LoadPicture(em) MyPicture.Picture = LoadPicture(mm) End If Set MyPicture = Nothing On Error GoTo 0 End Sub Private Function kh_img(Tg As String) As Object Dim Col As Range Dim r As Integer Set kh_img = Nothing For Each Col In Range(MyRng).Areas r = r + 1 If Col.Address = Tg Then ''''''''اسماء عنصر الصورة مرتب مع النطاق Set kh_img = Choose(r, Me.Image1, Me.Image2, Me.Image3, Me.Image4, Me.Image5, Me.Image6) Exit For End If Next End Function

ممكن توضيح اكثر

لا توجد عندي هذه المشكلة شاهد المرفق الرقم السري لكنترول المدارس.rar