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

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

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

السلام عليكم ورحمة الله وبركاته كل عام وانتم بخير دالة kh_ShowImage دالة تمكنك من وضع صورة داخل شكل تلقائي اتوماتيكيا يمكنك تغيير اسم او مسار مجلد الصور من داخل كود الدالة وسائط الدالة NameImag اسم الصورة افتراضي ImagRng خلية وضع الصورة افتراضي MyWidth عرض الصورة اختياري MyHeight طول الصورة اختياري ـ اذا لم تحدد طول او عرض معين للصورة تاخذ الصورة عرض وطول الخلية الموضوعة فيها ImagRng ـ اذا قمت بتحريك الصورة يدويا تفقد الصورة ارتباطها بالدالة وعند تحديث الدالة تقوم باضافة الصورة مرة اخرى في مكانها المحدد في الدالة كود الدالة: Option Explicit Option Compare Text '============================================= ' عرض صورة في الخليةِ ' Showing an image in cell '============================================= ' اسم مجلد الصور ' اذا كان مجلد الصور في نفس مجلد ملف الاكسل ' اكتب اسمه فقط ' والا اكتب المسار كاملا ' "D:\MyDocument\MyFunction\photo" Private Const kh_pic As String = "MyImeg" '============================================= ' امكانية تحرير اي نوع من الصور لديك ادناه Private Const MyTyp As String = ".jpg,.bmp,.gif,.png,.tif" '============================================= '============================================= Function kh_ShowImage(ByVal NameImag, ByVal ImagRng As Range, Optional ByVal MyWidth As Single, Optional ByVal MyHeight As Single) Dim Tp Dim shp As Shape Dim ibo As Boolean Dim MyTop As Single, MyLeft As Single Dim MyFile As String, MyPath As String '---------------------------------- On Error GoTo 1 '---------------------------------- MyTop = ImagRng.Top: MyLeft = ImagRng.Left With ImagRng.Worksheet For Each shp In .Shapes If shp.Top = MyTop And shp.Left = MyLeft Then shp.Delete: Exit For End If Next shp End With '----------------------------------- If IsEmpty(NameImag) Then GoTo 1 '----------------------------------- If MyWidth = 0 Then MyWidth = ImagRng.Width If MyHeight = 0 Then MyHeight = ImagRng.Height '----------------------------------- If Not InStr(kh_pic, ":") Then MyPath = ThisWorkbook.path & "\" MyFile = MyPath & kh_pic & "\" & CStr(NameImag) '----------------------------------- For Each Tp In Split(MyTyp, ",") If Not Dir(MyFile & Trim(Tp), vbDirectory) = vbNullString Then With ImagRng.Worksheet.Shapes.AddShape(msoShapeRectangle, MyLeft, MyTop, MyWidth, MyHeight) .Fill.UserPicture MyFile & Trim(Tp) End With ibo = True Exit For End If Next 1 kh_ShowImage = ibo End Function المرفق 2003-2010 دالة عرض صورة في خلية بطول وعرض اختياري.rar

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

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

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

السلام عليكم يمكك حفظ المسار في خلية معينة مثلا A1 المرفق 2010 ادراج صوره فى لابل.rar

ضع المعادلة هذه في B2 واسحبها على باقي العمود =VLOOKUP(A2;$G$2:$I$6;3) تحياتي

السلام عليكم Range("C5").Value = TextBox1.Value & " " & TextBox2.Value تحياتي

السلام عليكم ممكن هذه ضعها في الخلية E3 في المرفق مشاركة 1 واسحبها عل العمود =IF(SUM(C3:D3);SUM(E2;C3)-SUM(D3);"") تحياتي

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

السلام عليكم لم نفهم المطلوب بالضبط لكن هذه محاولة Data++.rar

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

غير هذا السطر من الكود Start_Circles If Val(Col) < Val(Cells(MyRow, C)) Then بهذا السطر If Val(Col) < Val(Cells(MyRow, C)) / 2 Then تحياتي

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

السلام عليكم هذا مثال للعمود سي واي Set MyRng = ActiveSheet.Range("C4:C23,E4:E23") وصف الدرجة الصغرى هو الصف 3 المرفق 2003 الدوائر الحمراء.rar

هذه الدالة تعمل مع مجلد واحد فقط يتم تحديده في كود الدالة تحياتي

السلام عليكم احسنت اخي الحبيب /جمال تقبلوا تحياتي وشكري

السلام عليكم بعد ما تحذف الصفوف استخدم الكود هذا لحذف الازرار التي ارتفاعها صفر Sub ragab() Dim shp As Shape For Each shp In ActiveSheet.Shapes If shp.Height = 0 Then shp.Delete Next End Sub تحياتي

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

السلام عليكم شاهد المرفق 2003 جوده.rar

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

وعليكم السلام اكرمكم الله واثابكم بدعائكم واعطاكم بمثله اضعاف مضاعفة تقبلوا تحياتي وشكري

السلام عليكم تم تعديل العنوان ودمج الموضوعين الذين هما نفس الطلب وارجوا الاهتمام مستقبلا بالعنوان وعدم فتح اكثر من موضوع لطلب واحد شاهد المرفق 2010 الرجاء المساعده.rar

السلام عليكم شاهد المرفق 2003 اخفاء وعرض البيانات.rar